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PREFACE 


The  purpose  of  IDA  Memorandum  Report  M-361,  Example  Level  1  Ada/SQl  System 
Software,  is  to  forward  data  developed  in  the  course  of  an  investigation.  This  Memorandum 
Report  presents  the  actual  software  source  code  which  implements  the  specification  found  in 
IDA  Memorandum  Report  M-361,  Level  1  Ada/SQL  Database  Language  Interface  User’s 
Guide. 

This  document  partially  fulfills  the  objective  of  Task  Order  T-T5-423,  Defense  Logistics 
Agency  Information  Systems,  which  is  to  provide  a  capability  for  accessing  a  relational 
database  from  the  Ada  language.  IDA  Memorandum  Report  M-361  will  be  used  to  provide 
the  actual  means  of  accessing  the  relational  database  UNIFY  with  the  Ada  language.  As  a 
Memorandum  Report,  M-361  is  directed  to  those  users  of  Ada/SQL  within  the  Defense 
Logistics  Agency. 
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1.  Introduction 


This  report  documents  the  demonstration  software  provided  to  the  Defense  Logistics  Agency,  in 
partial  fulfillment  of  EDA  task  T-T5-423  ”DLA  Information  Systems.”  This  software  demonstrates 
an  interface  between  the  Ada  programming  language  and  the  database  language  SQL  as  imple¬ 
mented  by  the  UNIFY  database  package.  An  interface  between  Ada  application  programs  and  the 
UNIFY  database  was  identified  as  a  necessary  capability  that  must  be  demonstrated  to  show  that 
Ada  applications  can  be  integrated  with  the  DLA  operational  environment.  This  interface  imple¬ 
ments  a  sub-set  of  the  ANSI  SQL  standard  that  reflects  the  current  implementation  of  SQL  by  the 
UNIFY  database  package.  However,  this  software  can  easily  be  upgraded  to  support  an  ANSI 
implementation  of  SQL  when  it  is  acquired  by  DLA. 


2.  Package  UNIFY_DEFINrnONS 


with  TEXT_IO; 
use  TEXT_IO ; 


package  UNIFY_DEFINITIONS  is 


type  TYPE_EXEC  is  (UNKNOWN,  DELETE,  FETCH,  INSERT,  SELEC,  UPDATE); 
type  STATUS_FILE  is  ( NOT_CREATED ,  CREATED,  OPEN,  DONE,  CLOSED,  DELETED); 
type  TYPE_RESULT  is  (NONE,  SUCCESS,  NOT_FOUND,  NOT_UNIQUE,  ERROR); 


type  CURS OR_N AME 
record 
IN  FILE 


RECORD  is 


IN  STAT 


OUT_FILE 
OUT_STAT 
ERR  FILE 


ERR  STAT 


SEQ_NUM 
SEQ_STR 
SEQ_LEN 
EXEC_TYPE 
RESULT_TYPE 
GOT_DATA 
BUFFER 
BUF_LEN 
BUF_PTR 
BUF_ROW 
end  record; 


FILE_TYPE; 

STATUS_FILE  :=  NOT_CREATED ; 
FILE_TYPE; 

STATUS_FILE  :=  NOT_CREATED; 
FILEJTYPE; 

STATUS_FILE  :=  NOT_CREATED; 

NATURAL  :=  0; 

STRING  (1..10)  :=  (others  =>  '  '); 
NATURAL  :=  0; 

TYPE_EXEC  :  =  UNKNOWN; 

TYPE_RESULT  :=  NONE; 

BOOLEAN  :=  FALSE; 

STRING  (1..1024)  :=  (others  =>  '  ') 


NATURAL 

NATURAL 

NATURAL 


type  CURSOR_NAME  is  access  CURSOR_NAME_RECORD; 


NOT_FOUND_ERROR  :  exception; 
UNIFY_ERROR  :  exception; 
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UNIQUE_ERROR  :  exception; 


end  UNIFY  DEFINITIONS; 


3.  Package  UNIFY_VARIABLES 


with  UNIFYJDEFINITIONS; 
use  UNIFYJDEFINITIONS; 

package  UNIFY_VARIABLES  is 


SEQ_NUMBER 

GOT_PID 

INPUT_FILE_NAME_LEN 
INPUT_FILE_NAME 
OUT  P  UT_F I LE_NAME_LEN 
OUTPUT_FILE_NAME 

ERROR_F ILE_NAME_LEN 
ERROR_FILE_NAME 

A_NEW_LINE_1 

A_NEW_LINE 

A_NEW_LINE_LEN 

FETCH_CURSOR 

COLUMN 

COLUMN  LEN 


NATURAL  :=  0; 

BOOLEAN  :=  FALSE; 
constant  NATURAL  : =  16; 

STRING  (1. . INPUT_FILE_NAME_LEN)  :=  "ADA 
constant  NATURAL  : *  17 ; 

STRING  (1. . OUTPUT_FILE_NAME_LEN)  := 

" ADA_SQL_OUT_0  0000"; 

:  constant  NATURAL  : =  17; 

:  STRING  ( 1 . . ERROR_FILE_NAME_LEN)  := 

" AD A_SQL_ERR_0  0000"; 

:  constant  CHARACTER  ;=  ascii.cx; 

:  constant  STRING  :=  ascii. cr  &  ascii. If; 
:  constant  NATURAL  : =  2; 

:  CURSOR_NAME  :=  null; 

:  STRING  (1..1024)  :=  (others  =>  '  '); 

:  NATURAL  :=  0; 


=  "ADA_SQL_IN_00000"; 


end  UNIFY_VARIABLES; 


4.  Package  UNIFY JERRORS 


package  UNIFY_ERRORS  is 

ERROR_BUFFER  :  STRING  (1..500)  : 

ERROR  BUFFER  LEN  :  NATURAL  :=  0; 


=  ( others  =>  '  '  )  ; 


end  UNIFY_ERRORS  ; 
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5.  Package  Specification  UNIFYJSUBROUTINES 


with  TEXT_IO,  UNIFY_DEFINITIONS,  UNIFY_VARIABLES,  UNIFY_ERRORS  ; 
use  TEXT_IO,  UNIFY_DEFINITIONS,  UNIFY_VARIABLES ,  UNIFY_ERRORS; 

package  UNIFY_SUBROUTINES  is 


procedure  SEQ__NUM_TO_STRING 


( SEQ_NUM 
STR 
LEN 


in  NATURAL; 
in  out  STRING; 
in  out  NATURAL); 


procedure  READ_FOR_ERRORS 

(CURSOR  :  in  CURSOR_NAME; 
ERR  :  out  NATURAL); 


procedure  READ_A_LINE 
(TYPE_FILE 
STAT_FILE 
BUF 

BUF  LEN 


in  FILE_TYPE; 
in  out  STATUS_FILE; 
in  out  STRING; 
out  NATURAL); 


procedure  SET_UP_OUT_FILE 

(CURSOR  :  in  CURSOR_NAME ; 
ERR  :  out  NATURAL ) ; 


95 
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procedure  RESPONSE 

(TYP  :  in  TYPE_EXEC; 

ERR  :  out  NATURAL ) ; 


procedure  IS_NUMERIC 
(BUF 
PTRO 
PTR9 

TRUE_FALSE 

ZERO 


in  STRING; 
in  out  NATURAL; 
in  NATURAL; 
out  BOOLEAN; 
out  BOOLEAN) ; 


procedure  IS_STRING 
(BUF 
PTRO 
PTR9 
CMPR 

TRUE  FALSE 


in  STRING; 
in  out  NATURAL; 
in  NATURAL; 
in  STRING; 
out  BOOLEAN); 


function  NEXT_COLUMN 

(CURSOR  :  in  CURSOR, NAME) 
return  BOOLEAN; 

procedure  ADD_PIDNO 
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(STR  :  in  out  STRING; 
PID  :  in  INTEGER); 


end  UNIFY  SUBROUTINES; 


6.  Package  Body  UNIFY JSUBROUTINES 


package  body  UNIFY_SUBROUTINES  is 


SEQ  NUM  TO  STRING 


procedure  SEQ_NUM_TO_STRING 


( SEQ_NUM 
STR 
LEN 


in  NATURAL; 
in  out  STRING; 
in  out  NATURAL)  is 


TSTR  :  STRING  (1..10)  :=  (others  =>  '  '); 
TLEN  :  NATURAL  :=  0; 

begin 

TLEN  :=  NATURAL' IMAGE  ( SEQ_NUM) ' LENGTH ; 
TSTR  (1..TLEN)  :=  NATURAL ' IMAGE  (SEQ_NUM), 
LEN  :=  0; 

for  I  in  1 . . TLEN  loop 

if  TSTR  (I)  in  'O'.. '9'  then 
LEN  :=  LEN  +  1; 

STR  (LEN)  :=  TSTR  (I); 
end  if; 
end  loop; 

end  SEQ  NUM  TO  STRING; 


—  READ_F0R_ERR0RS 

—  open  and  read  the  error  file  created  by  the  execution  of  the  unify  query 

—  ERR  =  0  if  nothing  in  the  file 

—  ERR  =  1  if  "There  were  no  records  selected." 

—  ERR  =  2  if  any  other  error 

—  if  any  errors  stuff  the  whole  message  in  the  error  message  buffer 

procedure  READ_F0R_ERR0RS 

(CURSOR  :  in  CURSOR_NAME; 

ERR  :  out  NATURAL)  is 
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LINES_READ 

NATURAL 

0; 

PTR 

NATURAL 

0; 

LEN 

NATURAL 

0; 

begin 

ERR  :=  0; 

OPEN  (CURSOR. ERR_FILE,  IN_FILE, 

ERROR_FILE_NAME  (1. . ERROR_FILE_NAME_LEN)  4  " . "  4 
CURSOR . SEQ_STR  ( 1 . . CURSOR . SEQ_LEN ) ) ; 

CURSOR. ERR_STAT  :=  OPEN; 

ERROR_BUFFER_LEN  :=  0; 
loop 

PTR  :=  ERROR_BUFFER_LEN  +  1; 

LEN  :=  0; 

R£AD_A_LINE  (CURSOR . ERR_FILE,  CURSOR . ERR_STAT, 

ERROR_BUFFER  (PTR  ..  ERROR_BUFFER ' LAST ) ,  LEN); 
if  LEN  >  0  then 

LEN  :=  LEN  -  ERROR_BUFFER_LEN; 
end  if; 

if  CURSOR . ERR_STAT  =  DONE  then 
DELETE  ( CURSOR . ERR_FILE ) ; 

— CLOSE  ( CURSOR .  EP.R_FILE )  ; 

CURSOR . ERR_STAT  :=  DELETED; 
return; 
end  if; 

ERROR_BUFFER_LEN  : =  ERROR_BUFFER_LEN  +  LEN; 
if  LEN  >  0  then 

LINES_READ  :=  LINESJREAD  +  1/ 

if  LINES_READ  =  1  and  then  ERROR_BUFFER  ( 1 . . ERROR_BUFFER_LEN)  = 

"There  were  no  records  selected."  then 

ERR  :=  1; 
else 

ERR  :=  2; 
end  if; 

ERROR_BUFFER  ( ERROR_BUFFER_LEN  +  1  . .  ERROR_BUFFER_LEN  +  A_NEW_LINE_LEN ) 
:=  A_NEW_LINE ; 

ERROR_BUFFER_LEN  :=  ERROR_BUFFER_LEN  +  A_NEN_LINE_LEN; 
end  if; 
end  loop; 

end  READ_FOR_ERRORS ; 


—  READ_A_LINE 

—  given  a  cursor  name,  return  the  next  line  in  the  buffer 

procedure  READ_A_LINE 

( TYPE_FILE  :  in  FILE_TYPE; 

STAT_FILE  :  in  out  STATUS_FILE; 
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BUF  :  in  out  STRING; 

BUF_LEN  :  out  NATURAL)  is 

begin 

BUF_LEN  :=  0; 
if  STATJFILE  =  OPEN  then 

GET_LINE  (TYPE_FILE,  BUF,  BUF_LEN)  ; 
end  if; 

exception 

when  ENDJERROR  =>  STAT_FILE  :=  DONE; 

BUF_LEN  :=  0 ; 

end  READ  A  LINE; 


—  SET_UP_OUT_FILE 

—  open  and  read  the  output  file  created  by  the  execution  of  the  unify  query 

—  ERR  =  0  if  the  file  consists  of  a  title  line  then  a  -  line 

—  ERR  =  1  if  file  is  empty  -  not_found_error 

—  ERR  =  2  if  any  other  error  -  unify_error 

—  ERR  =  3  multiple  rows  on  select  -  unique_error 

—  if  any  errors  stuff  the  whole  message  in  the  error  message  buffer 

procedure  SET_UP_OUT_FILE 

(CURSOR  :  in  CURSOR_NAME ; 

ERR  :  out  NATURAL)  is 


LINES_READ 

PTR 

LEN 

. SLECT_THIS 
D_BUF 
D  LEN 


NATURAL  :=  0; 
NATURAL  :=  0; 
NATURAL  :=  0; 
BOOLEAN  : =  FALSE; 
STRING  (1. . 1024) 
NATURAL  :=  0; 


:  =  ( others  =  >  '  '  ) , 


begin 

ERR  :=  0; 

OPEN  (CURSOR. OUTJFILE,  IN_FILE, 

OUTPUT_  FILE_NAME  ( 1 .  . OUTPUT_FILE_NAME_LEN )  &  S 

CURSOR . SEQ_STR  ( 1 . . CURSOR . SEQ_LEN ) ) ; 

CURSOR . 0UT_STAT  :=  OPEN; 

CURSOR. BUF_LEN  :=  0; 

CURSOR. BUF_PTR  :=  0; 

CURSOR . BUF_ROW  :*  0; 

ERROR_BUFFER_LEN  :=  0; 
loop 

if  LINES_READ  >=  2  and  CURSOR . EXEC_TYPE  =  SELEC  then 
SELECT_THIS  :=  TRUE; 
else 
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SELECT_THIS  :«  FALSE; 
end  if; 

exit  when  CURSOR .  EXEC_TYPE  =*  FETCH  and  LINES_READ  -  2; 
PTR  ERROR_B  UF  F  ER_LEN  +  1; 

LEN  0; 

if  SELECT_THIS  then 

if  LINES_READ  “  2  then 

READ_A_LINE  (CURSOR . OUT_FILE,  CURSOR . OUT_STAT , 
CURSOR. BUFFER,  CURSOR . BUF_LEN ) ; 

LEN  :=  0; 

if  CURSOR. BUF_LEN  >  0  then 

CURSOR . BUF_ROW  :=  CURSOR . BUF_R0W  +  1; 

LEN  :=  CURSOR. BUF_LEN; 

CURSOR. BUF_PTR  :=  1; 
end  if; 
else 


READ_A_L I NE  ( CURSOR . OUT_FILE,  CURSOR . OUT_STAT , 
D_BUF,  D_LEN) ; 

LEN  :=  0; 
if  D_LEN  >  0  then 

CURSOR . BUFROW  :=  CURSOR . BUF_ROW  +  1; 

LEN  :=  D_LEN; 
end  if; 
end  if; 


else 

READ_A_LINE  (CURSOR. OUT_FILE,  CURSOR . OUT_STAT , 

ERROR_BUFFER  (PTR  ..  ERROR_BUFFER ' LAST ) , 
if  LEN  >  0  then 

LEN  :=  LEN  -  ERROR_BUFFER_LEN; 
end  if; 
end  if; 

if  CURSOR . OUT_STAT  =  DONE  then 
DELETE  ( CURSOR . OUT_F I LE ) ; 

— CLOSE  (CURSOR. OUT_FILE) ; 

CURSOR. OUT_STAT  :=  DELETED; 


case  CURSOR . EXEC  TYPE  is 


when 

UNKNOWN 

=  > 

ERR  : =  2  ; 

when 

DELETE 

=  > 

RESPONSE  (DELETE, 

ERR)  ; 

when 

FETCH 

=  > 

ERR  :=  2; 

when 

INSERT 

=  > 

RESPONSE  (INSERT, 

ERR)  ; 

when 

SELEC 

=  > 

if  CURSOR. BUF  ROW 

<  1  then 

ERR  :=  2; 

els  if  CURSOR . BUF_ROW  >  1  then 
ERR  :=  3; 
end  if; 

When  UPDATE  =>  RESPONSE  (UPDATE,  ERR); 
end  case,- 
return ; 
end  if; 

if  LEN  >  0  then 


LEN)  ; 
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LINES_READ  :-  LINES_READ  +  1; 
if  not  SELECT_THIS  then 

ERROR, BUFFER_LEN  ERROR_BUFFER_LEN  +  LEN; 

ERROR_BUFFER  (ERROR_BUFFER_LEN  +  1  . .  ERROR_BUFFER_LEN  + 
A_NEW_LINE_LEN)  :«  A_NEW_LINE; 
ERROR_BUFFER_LEN  :=  ERROR_BUFFER_LEN  +  A_NEW_LINE_LEN; 
end  if; 
end  if; 
end  loop; 

end  SET  UP  OUT  FILE; 


—  RESPONSE 


—  given  an  execute  type  and  the  response  from  unify  in  the  error  buffer 

—  see  if  it's  a  valid  delete,  update  or  insert  response 

—  err  =  0  valid 

—  err  =  1  not  found  error 

—  err  =  2  unify  error 


procedure  RESPONSE 

(TYP  :  in  TYPE_EXEC; 

ERR  :  out  NATURAL)  is 


TRUE_FALSE 

ZERO 

PTR 


BOOLEAN 

BOOLEAN 

NATURAL 


FALSE; 

FALSE; 

1; 


begin 

ERR  :=  0; 

IS_NUMERIC  (ERROR_BUFFER,  PTR,  ERROR_BUFFER_LEN,  TRUE_FALSE,  ZERO) ; 
if  not  TRUE_FALSE  then 
ERR  :=  2; 
return; 
end  if; 
if  ZERO  then 
ERR  :=  1; 
return; 
end  if; 

IS_STRING  (ERROR_BUFFER,  PTR,  ERROR_BUFFER_LEN,  "record ( s ) " ,  TRUE_FALSE); 
if  not  TRUE_FALSE  then 
ERR  :=  2; 
return; 
end  if; 
case  TYP  is 

when  DELETE  =>  IS_STRING  { ERROR_BUFFER ,  PTR,  ERROR_BUFFER_LEN , 
"selected,",  TRUE_FALSE) ; 

when  INSERT  =>  IS_STRING  ( ERROR_BUFFER,  PTR,  ERROR_BUFFER_LEN , 

"added . " ,  TRUE_FALSE) ; 
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when  UPDATE  =>>  IS_STRING  (ERROR_BUFFER,  PTR,  ERROR_BUFFER_LEN, 
"updated . " ,  TRUE_FALSE) ; 
when  others  «>  null; 
end  case; 

if  not  TRUE_FALSE  then 
ERR  2; 
return ; 
end  if; 

if  TYP  /=  DELETE  then 
return; 
end  if; 

IS_NUMERIC  (ERROR_BUFFER,  PTR,  ERROR_BUFFER_LEN,  TRUE_FALSE ,  ZERO); 
if  not  TRUE_FALSE  then 
ERR  :=  2; 
return ; 
end  if; 
if  ZERO  then 
ERR  :=  1; 
return; 
end  if; 

1S_STRING  ( ERROR_BUFFER ,  PTR,  ERROR_BUFFER_LEN ,  "record(s)  deleted", 
TRUE_FALSE ) ; 
if  not  TRUE_FALSE  then 
ERR  :=  2; 
return; 
end  if; 
end  RESPONSE; 


IS_NUMERIC 

given  a  buffer  and  a  pointer  to  the  current  spot  and  the  end 
look  for  a  number  first.  Ignore  leading  spaces  or  new_lines 
then  check  for  0-9  until  encountering  a  space  or  new_line 
if  only  Os  are  encountered  it's  a  zero 

procedure  IS_NUMERIC 

(BUF  :  in  STRING; 

PTRO  :  in  out  NATURAL; 

PTR9  :  in  NATURAL; 

TRUE_FALSE  :  out  BOOLEAN; 

ZERO  :  out  BOOLEAN)  is 

LEADING_SPACE  :  BOOLEAN  :=  TRUE; 

C  :  CHARACTER  : =  '  ' ; 

begin 

TRUE_FALSE  :=  TRUE; 

ZERO  :=  TRUE; 
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loop 

if  PTRO  >  PTR9  then 
return ; 
end  if; 

C  BUF  (PTRO); 
case  C  is 
when  '  ' 


when  A  NEW  LINE  1 


when  ' 0 ' 
when  ' 1 ' . . ' 9 ' 


when  others 


end  case; 

PTRO  :=  PTRO  +  1; 
end  loop; 
end  I S_NUMER I C ; 


=>  if  not  LEADING_SPACE  then 
return; 
end  if; 

=>  if  not  LEADING_SPACE  then 
return; 
end  if; 

PTRO  :=  PTRO  +  A_NEW_LI NE_LEN ; 
=>  LEADING_SPACE  :=  FALSE; 

=>  ZERO  :=  FALSE; 

LEAD ING_SP ACE  :=  FALSE; 

=>  TRUE_FALSE  :*  FALSE; 

ZERO  :=  FALSE; 
return; 


--  IS_STRING 

—  given  a  buffer  and  a  pointer  to  the  current  spot  and  the  end 

—  look  for  a  string  that  matches  "cmpr".  Ignore  spaces  and  new_lines 

—  in  the  buffer  and  the  compare  string. 


procedure  IS_STRING 
(BUF 
PTRO 
PTR9 
CMPR 

TRUE  FALSE 


in  STRING; 
in  out  NATURAL; 
in  NATURAL; 
in  STRING; 
out  BOOLEAN)  is 


KT. 


SI 


B 

C 

CP 


CHARACTER 

CHARACTER 

NATURAL 


_  r 

—  t 

=  1; 


begin 

TRUE_FALSE  :=  FALSE; 
loop 

exit  when  PTRO  >  PTR9  or  CP  >  CMPR 'LAST; 
loop 

exit  when  PTRO  >  PTR9; 

B  :=  BUF  (PTRO); 
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if  B  =  '  '  then 
PTRO  PTRO  +  1; 
elsif  B  »  A_NEW_LINE  (1)  then 

PTRO  :  =  PTRO  +  A_NEW_LINE_LEN  -  1; 
else 
exit; 
end  if; 
end  loop; 
loop 

exit  when  CP  >  CMPR'LAST; 

C  :=>  CMPR  (CP); 
if  C  *  '  '  then 
CP  :=  CP  +  1; 

elsif  C  =  A_NEW_LINE  (1)  then 
CP  :=  CP  +  A_NEW_LINE_LEN  -  1; 
else 
exit; 
end  if; 
end  loop; 

B  : =  BUF  ( PTRO ) ; 

C  :=  CMPR  (CP); 

if  B  in  'a' . . ' 2'  then 

B  :=  CHARACTER' VAL  ( CHARACTER ' POS  (B) 
end  if; 

if  C  in  'a' . . ' z'  then 

C  CHARACTER 'VAL  ( CHARACTER' POS  (C) 

end  if; 

if  B  /*»  C  then 
return; 
end  if; 

PTRO  :=  PTRO  +  1; 

CP  :=  CP  +  1; 
end  loop; 

if  CP  >  CMPR'LAST  then 
TRUE_FALSE  : =  TRUE; 
end  if; 

end  IS  STRING; 


NEXT_COLUMN 

function  NEXT_COLUMN 

(CURSOR 

:  in  CURSOR_NAME) 

return 

BOOLEAN  is 

LEADING_SPACES 

:  BOOLEAN  :=  TRUE; 

BUF_PTR_START 

:  NATURAL  :=  CURSOR . BUF_PTR; 

BUF_PTR_END 

:  NATURAL  :=  CURSOR . BUF_PTR ; 
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begin 

COLUMNJLEN  : =  0; 

if  (CURSOR.  EXECJTYPE  -  FETCH  and  CURSOR .  OUT_STAT  /=*  OPEN)  or 
CURSOR. RESULT_TYPE  /=  SUCCESS  or 
CURSOR. BUF_PTR  >  CURSOR . BUF_LEN  or 
CURSOR. BUF_LEN  <  1  then 
return  FALSE; 
end  if; 
loop 

exit  when  CURSOR . BUFFER  (CURSOR. BUF_PTR)  -  ' | ' ; 
exit  when  CURSOR . BUF_PTR  >  CURSOR. BUF_LEN; 

if  not  LEADING_SPACES  or  else  CURSOR. BUFFER  ( CURSOR . BUF_PTR)  /= 
LEADING_SPACES  :=  FALSE; 

COLUMN_LEN  :=  COLUMN_LEN  +  1; 

COLUMN  ( COLUMN _LEN )  :=  CURSOR . BUFFER  (CURSOR . BUF_PTR) ; 
end  if; 

CURSOR . BUF_PTR  :=  CURSOR . BUF_PTR  +  1; 
end  loop; 

BUF_PTR_END  :=  CURSOR . BUF_PTR; 
if  CURSOR . BUF_PTR  <=  CURSOR . BUF_LEN  and  then 
CURSOR. BUFFER  (CURSOR . BUF_PTR)  =  '  |  '  then 
CURSOR . BUF_PTR  :=  CURSOR . BUF_PTR  +  1; 
end  if; 

if  BUF_PTR_END  <=  BUF_PTR_START  then 
return  FALSE; 
end  if; 
loop 

exit  when  COLUMN_LEN  <  1; 

exit  when  COLUMN  (COLUMN_LEN)  /=  '  '; 

COLUMN_LEN  :=  COLUMN_LEN  -  1; 
end  loop; 

if  COLUMN_LEN  <  1  then 
COLUMNJLEN  :=  1; 

COLUMN  (COLUMN_LEN)  :=  ' 
end  if; 
return  TRUE; 
end  NEXT  COLUMN; 


—  ADDJPIDNO 

procedure  ADD_PIDN0 

(STR  :  in  out  STRING; 
PID  :  in  INTEGER)  is 


then 


TSTR 

STRING  (1 

.  .10) 

:=  (others  => 

TEND 

INTEGER  : 

=  0; 

TBEG 

INTEGER  : 

=  0; 

PSTR 

STRING  (1 

■  5) 

=  (others  => 
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II  :  INTEGER  :-  0; 
begin 

for  I  in  STR ' FIRST. .STR' LAST  loop 
II  :»  I; 

exit  when  STR  (I)  -  ascii. nul; 
end  loop; 

TEND  :=  INTEGER' IMAGE  (PID)'LAST; 

TSTR  ( 1 . . TEND )  :«  INTEGER ' IMAGE  (PID) ; 
for  I  in  1. .TEND  loop 
TBEG  I; 

exit  when  TSTR(I)  in  '0'..'9'; 
end  loop; 

PSTR  (  (5  -  (TEND  -  TBEG) >..5)  :=  TSTR  (TBEG.. TEND) 

if  II  +  4  <-  STR' LAST  then 

STR  (II..II+4)  :=  PSTR  (1..5); 
end  if; 

end  ADD  PIDNO; 


end  UNIFY  SUBROUTINES; 


7.  Package  UNIFYJROUTINES 


with  TEXT__IO,  SYSTEM,  UNIFY_DEFINITIONS ,  UNIFY_VARIABLES ,  UNIFY_SUBROUTINES , 
UNIFY_ERRORS ; 

use  TEXT_I0,  SYSTEM,  UNIFY_DEFINITIONS,  UNIFY_VARIABLES ,  UNIFY_SUBROUTINES , 
UNIFY_ERRORS ; 

package  UNIFY_ROUTINES  is 

procedure  CREATE_ADA_SQL_INPUT_F ILE 

(CURSOR  :  in  out  CURSOR_NAME) ; 

procedure  EXECUTE_ADA_SQL_FILE 

(CURSOR  :  in  out  CURSOR_NAME) ; 

procedure  FETCH 

(CURSOR  :  in  CURSOR_NAME) ; 

generic 

type  USERJTYPE  is  (<>); 
procedure  INTEGER_AND_ENUMERATION_INTO 
(VAR  :  out  USERJTYPE); 

generic 

type  USERJTYPE  is  digits  <>; 
procedure  FLOAT_INTO 
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(VAR  :  out  USERJTYPE); 


generic 

type  INDEXJTYPE  is  range  <>; 
type  COMPONENT_TYPE  is  (<>); 

type  USERJTYPE  is  array  (  INDEXJTYPE  range  <>  )  of  COMPONENT_TYPE ; 
with  function  CONVERT_CHARACTERJTO_COMPONENT 
(C  :  CHARACTER) 
return  COMPONENT_TYPE  is  <>; 
pro  idure  UNCONSTRAINED_STRING_INTO 
(VAR  :  out  USERJTYPE; 

LAST  :  out  INDEXJTYPE ) / 


generic 

type  INDEXJTYPE  is  range  <>; 
type  COMPONENT JTYPE  is  (<>); 

type  USER_TYPE  is  array  (  INDEX_TYPE  )  of  COMPONENT  JTYPE ; 
With  function  CONVERT_CHARACTER_TO_COMPONENT 
(C  :  CHARACTER) 
return  COMPONENT  JTYPE  is  <>; 
procedure  CONSTRAINED_STRING_INTO 
(VAR  :  out  USERJTYPE; 

LAST  :  out  INDEXJTYPE ) ; 

end  UNIFY_ROUTINES; 

package  body  UNIFY_ROUTINES  is 


—  CREATE_ADA_SQL_INPUT_FILE 

—  this  routine  creates  and  opens  a  new  file  "ada_sql_in_pid. seq"  where  pid 

—  is  the  process  id  for  this  program  and  seq  is  a  sequential  number  assigned 

—  to  the  input  files.  This  file  is  where  the  UNIFY  query  will  be  written 

—  out  to  for  later  execution . 

procedure  CREATE_ADA_SQL_INPUT_FILE 

(CURSOR  :  in  out  CURSOR_NAME)  is 

MYJPID  :  INTEGER  :=  0; 
function  CGETPID  return  INTEGER; 
pragma  Interface  (C,  CGETPID); 

begin 

if  not  G0T_PID  then 

INPUT_FILE_NAME  ( INPUT_FILE_NAME_LEN  -  4)  :=  ascii. nul; 

OUTP UT_F I LE_NAME  ( OUTP UT_F I LE_NAME_L EN  -  4)  : =  ascii. nul; 
ERROR_FILE_NAME  ( ERROR_FILE_NAME_LEN  -  4)  :=  ascii. nul; 

MY  PID  r  *  CGETPID; 
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ADD_PXDNO  (INPUT_FILE_NAME,  MY_PID) ; 

ADD_PIDNO  (OUTPUT_FILE_NAME,  MY_PID) ; 

ADD_PIDNO  (ERROR_FILE_NAME,  MY_PID); 

GOT_PID  :»  TRUE; 
end  if; 

SEQ_NUMBER  SEQ_NUMBER  +  1; 

CURSOR . SEQ_NUM  :=  SEQ_NUMBER; 

SEQ_NUM_TO_STRING  ( SEQ_NUMBER,  CURSOR . SEQ_STR,  CURSOR. SEQ_LEN) ; 
CREATE  (CURSOR. IN_FILE,  OUT_FILE, 

INPUT_FILE_NAME  ( 1 . . INPUT_FILE_NAME_LEN)  a  "."  & 

CURSOR . SEQ_STR  ( 1 . . CURSOR . SEQ_LEN ) ) ; 

CURSOR. IN_STAT  :=  OPEN; 

PUT_LXNE  (CURSOR. IN_FILE,  "lines  99999999999"); 
end  CREATE  ADA  SQL  INPUT  FILE; 


EXECUTE_ADA_SQL_FILE 

close  the  ada  sql  input  file  that  was  created  in  create_ada_sql_input_f ile 
call  unix  to  execute  the  file  and  put  the  output  in  a  file  called 
"ada_sql_out_pid. seq"  and  the  error  output  in  a  file  called 
"ada_sql_err_pid. seq"  where  pid  is  the  process  id  for  this  program  and 
seq  is  a  sequential  number  assigned  to  the  output  files . 

Delete  the  file  ada_sql_in_pid. seq 

Open  the  error  file  and  the  output  file,  if  we  have  an  error  other  than 
"There  were  no  records  selected."  raise  the  UNI FY_ERROR  exception. 

If  "There  were  no  records  selected."  and  this  is  an  execute  for  a  fetch 
just  wait  and  raise  NOT_F 0 UND_ERROR  exception  when  the  user  makes  his 
first  call  to  FETCH.  If  it's  any  other  kind  of  execute  raise 
NOT_FOUND_ERROR  exception  now.  If  it's  a  delete  make  sure  the  comment 
is  "x  record(s)  selected,  x  record(s)  deleted.".  If  it's  an  insert  make 
sure  the  comment  is  "x  record(s)  added.".  If  it's  an  update  make  sure 
the  comment  is  "x  record(s)  updated.". 

procedure  EXECUTE_ADA_SQL_FILE 

(CURSOR  :  in  out  CURSOR_NAME )  is 

subtype  ADDRESS  is  SYSTEM . ADDRESS ; 
procedure  CSYSTEM  (STR  :  ADDRESS); 
pragma  Interface  (C,  CSYSTEM); 

TMP  :  STRING  (1..200)  :=  (others  =>  '  '  ) ; 

TMP_LEN  :  NATURAL  :=  0; 

ERR  :  NATURAL  :=  0; 


begin 

FETCH_CURSOR  :=  CURSOR; 

CLOSE  ( CURSOR . IN_FILE ) ; 

CURSOR . IN_STAT  : =  CLOSED ; 

TMP_LEN  :=  4  +  INPUT_FILE_NAME_LEN  +  1  +  CURSOR . SEQ_LEN  +  2  + 
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OUTPUT_FILE_NAME_LEN  +  1  +  CURSOR . SEQ_LEN  +  3  + 

ERROR_F I LE_NAME_LEN  +  1  +  CURSOR . SEQ_LEN  +  1/ 

TMP  (1.  .  TMP_LEN )  "SQL  "  &  INPUT_FILE_NAME  ( 1 . . INPUT_FILE_NAME_LEN)  & 

&  CURSOR . SEQ_STR  ( 1 .. CURSOR . SEQ_LEN )  &  "  >"  & 
OUTPUT_FILE_NAME  { 1 . . OUTPUT_FILE_NAME_LEN)  &  & 

CURSOR . SEQ_STR  ( 1 . . CURSOR . SEQ_LEN )  S 
"  2>"  &  ERROR_FILE_NAME  ( 1 . . ERROR_FILE_NAME_LEN)  & 

"."  &  CURSOR . SEQ_STR  ( 1 .. CURSOR . SEQ_LEN )  &  ascii.nul; 
— PUT_LINE  ("going  to  unify:"); 

— PUT_LINE  ( "  "  &  TMP  ( 1 . . TMP_LEN ) ) ; 

CSYSTEM  ( TMP ' ADDRESS ); 

CURSOR. OUT_STAT  :»  CREATED; 

CURSOR . ERR_STAT  :»  CREATED; 

OPEN  (CURSOR. IN_FILE,  IN_FILE, 

XNP UT_F I LE_NAME  ( 1 .  . INPUT_FILE_NAME_LEN )  S  6 

CURSOR . SEQ_STR  ( 1 . . CURSOR . SEQ_LEN ) ) ; 

DELETE  ( CURSOR . IN_FILE ) ; 

— CLOSE  ( CURSOR . IN_FILE ) ; 

CURSOR . IN_STAT  :=  DELETED; 

READ_FOR_ERRORS  (CURSOR,  ERR) ; 
if  ERR  «  0  then 

SET_UP_OUT_FILE  (CURSOR,  ERR) ; 
else 

OPEN  (CURSOR. OUT_FILE,  IN_FILE, 

OUTPUT_FILE_NAME  ( 1 . . OUTPUT_FILE_NAME_LEN)  S  & 

CURSOR . SEQ_STR  ( 1 . . CURSOR . SEQ_LEN ) ) ; 

CURSOR. OUT_STAT  :=  OPEN; 

DELETE  ( CURSOR . OUT_FILE ) ; 

— CLOSE  (CURSOR. OUT_FILE) ; 

CURSOR . OUT_STAT  :=  DELETED; 
end  if; 
case  ERR  is 

when  0  =>  CURSOR . RESULT_TYPE  :=  SUCCESS; 
when  1  =>  CURSOR . RESULT_TYPE  :=  NOT_FOUND; 

When  2  =>  CURSOR . RESULTJTYPE  :=  ERROR; 
when  3  =>  CURSOR . RESULT_TYPE  :=  NOT_UNIQUE; 


When  0  =>  CURSOR . RESULT_TYPE  :=  SUCCESS; 
when  1  =>  CURSOR . RESULTJTYPE  :=  NOT_FOUND; 
When  2  =>  CURSOR . RESULT_TYPE  :=  ERROR; 
when  3  =>  CURSOR . RESULT_TYPE  :=  NOT_UNIQUE; 
when  others  =>  null; 
end  case; 

if  ERR  -  1  and  CURSOR. EXEC_TYPE  /=  FETCH  then 
raise  NOT_FOUND_ERROR ; 
elsif  ERR  =  2  then 
raise  UN I FY_ERROR ; 
elsif  ERR  =  3  then 
raise  UNIQUE_ERROR ; 
end  if; 

end  EXECUTE  ADA  SQL  FILE; 
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—  user  is  ready  to  do  a  fetch,  save  the  cursor  to  do  the  following  intos 

—  from  and  read  the  next  line  of  the  output  file.  If  none  or  if  the 

—  query  had  been  unsuccessful  then  raise  NOT_FOUND_ERROR  exception. 

—  when  reaching  the  end  of  the  file,  delete  it. 

procedure  FETCH 

(CURSOR  :  in  CURSOR_NAME )  is 

begin 

FETCH_CURSOR  :=  CURSOR; 

READ_A_LINE  ( FETCH_CURSOR . OUT_FILE ,  FETCH_CURSOR . OUT_STAT , 
FETCH_CURSOR . BUFFER ,  FETCH_CURSOR . BUF_LEN ) ; 
if  FETCH_CURSOR.OUT_STAT  /=  OPEN  or  else 

FETCH_CURSOR.RESULT_TYPE  /=  SUCCESS  then 
if  IS_OPEN  (FETCH_CURSOR.OUT_FILE)  then 
DELETE  ( FETCH_CURSOR . OUT_FILE ) ; 

— CLOSE  ( FETCH_CURSOR . OUT_FILE ) ; 

FETCH_CURSOR . OUT_STAT  : =  DELETED; 
end  if; 

raise  NOT_FOUND_ERROR ; 
end  if; 

FETCH_CURSOR . BUF_ROW  :=  FETCH_CURSOR . BUF_ROW  +  1; 

FETCH_CURSOR . BUF_PTR  :=  1; 
end  FETCH; 


—  INTEGER_AND_ENUMERATION_INTO 

procedure  INTEGER_AND_ENUMERATION_INTO 
(VAR  :  out  USER_TYPE)  is 

TMP  :  INTEGER  :=  0; 

TVAR  :  USERJIYPE; 


begin 

if  not  NEXT_COLUMN  ( FETCH_CURSOR )  then 
raise  NOT_FOUND_ERROR ; 
end  if; 

TMP  :=  INTEGER ' VALUE  (COLUMN  ( 1 . . COLUMN_LEN ) ) ; 
TVAR  USER_TYPE ' VAL  (TMP); 

VAR  : =  USER_TYPE ' VAL  ( TMP ) ; 
end  INTEGER_AND_ENUMERATION_INTO ; 


—  FLOAT_INTO 

procedure  FL0AT_INT0 

(VAR  :  out  USER_TYPE)  is 
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package  GET_FLOAT  is  new  FLOAT_IO  (USERJTYPE); 

LAST  :  POSITIVE  :-  1; 

begin 

if  not  NEXT_COLUMN  ( FETCH_CURSOR)  then 
raise  NOT_FOUND_ERROR; 
end  if; 

GET_FLOAT . GET  ( COLUMN  ( 1 . . COLUMN_LEN ) ,  VAR ,  LAST ) ; 
if  LAST  /=  COLUMN_LEN  then 
raise  DATA_ERROR; 
end  if; 

end  FLOAT_INTO; 


—  UNCONSTRAINED_STRING_INTO 

procedure  UNCONSTRAINED_STRING_INTO 
(VAR  :  out  USERJTYPE; 

LAST  :  out  INDEXJTYPE)  is 

V  :  INDEXJTYPE  :=  VAR' FIRST; 

begin 

if  not  NEXT_COLUMN  ( FETCH_CURSOR)  then 
raise  NOT_FOUND_ERROR ; 
end  if; 

LAST  :=  VAR' FIRST  +  INDEXJTYPE  ( COLUMN_LEN  -  1); 
for  I  in  1 . . COLUMN_LEN  loop 

VAR  (V)  :=  CONVERT J:hARACTERJTO_COMPONENT  (COLUMN  (I)); 
if  V  <  INDEXJTYPE' LAST  then 
V  :=  V  +  1; 
end  if; 
end  loop,- 

end  UNCONSTRAINED_STRING  INTO; 


—  CONSTRAINED_STRING_INTO 

procedure  CONSTRAINED_STRING_INTO 
(VAR  :  out  USER_TYPE; 

LAST  :  out  INDEXJTYPE)  is 

V  :  INDEXJTYPE  : =  VAR' FIRST; 


begin 

if  not  NEXT_COLUMN  ( FETCH_CURSOR)  then 
raise  NOT_FOUND_ERROR; 
end  if; 
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LAST  :=  VAR' FIRST  +  INDEX_TYPE  (COLUMN_LEN  -  1); 
for  I  in  1 . . COLUMN_LEN  loop 

VAR  (V)  :=  CONVERT_CHARACTER_TO_COMPONENT  (COLUMN  (I)); 
if  V  <  INDEX_TYPE ' LAST  then 
V  V  +  1; 
end  if; 
end  loop; 

end  CONSTRAINED_STRING_INTO; 
end  UNIFY  ROUTINES; 


8.  Package  TEXT_PRINT 

with  TEXT_IO; 
use  TEXT_IO; 

package  TEXT_PRINT  is 

type  LINE_TYPE  is  limited  private,- 

type  BREAK_TYPE  is  (BREAK,  NO_BREAK); 

type  PHANTOM_TYPE  is  private; 

procedure  CREATE_LINE ( LINE  :  in  out  LINEJTYPE;  LENGTH  :  in  POSITIVE) 
procedure  SET_LINE( LINE  :  in  LINE_TYPE) ; 
function  CURRENT_LINE  return  LINE_TYPE; 

procedure  SET_INDENT ( LINE  :  in  LINE_TYPE;  INDENT  :  in  NATURAL); 
procedure  SET_INDENT ( INDENT  :  in  NATURAL); 


procedure  SET_CONTINUATION_INDENT( LINE 

INDENT 

procedure  SET_CONTINUATION_INDENT( INDENT 


in  LINE_TYPE ; 
in  INTEGER); 
in  INTEGER); 


function  MAKE_PHANTOM(S  ;  STRING)  return  PHANTOM_TYPE; 

procedure  SET_PHANTOMS ( LINE  :  in  LINE_TYPE ; 

START_PHANTOM, 

END_PHANTOM  :  in  PHANTOMJTYPE) ; 

procedure  SET_PHANTOMS ( START_PHANTOM ,  END_PHANTOM  :  in  PHANTOM_TYPE ) 

procedure  PRINT ( FILE  :  in  FI LE_TYPE ; 

LINE  :  in  LINE  TYPE; 
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ITEM 

in 

STRING ; 

BRK 

in 

BREAK_TYPE  : =  BREAK ) ; 

procedure 

PRINT (FILE 

in 

FILE_TYPE; 

ITEM 

in 

STRING  ,■ 

BRK 

in 

BREAK_TYPE  ;=  BREAK); 

procedure 

PRINT (LINE 

in 

LINE_TYPE; 

ITEM 

in 

STRING; 

BRK 

in 

BREAK_TYPE  :=  BREAK); 

procedure 

PRINT (ITEM 

in 

STRING; 

BRK 

in 

BREAK_TYPE  :=  BREA;’)  ; 

procedure 

PRINT_LINE( FILE 

:  in  FILE_TYPE;  LINE 

procedure 

PRINTLINE  (FILE 

;  in  FILEJTYPE) ; 

procedure 

PRINT_LINE( LINE 

:  in  LINEJTYPE) ; 

procedure 

PRINTLINE; 

procedure 

BLANK_LINE ( F ILE 

:  in  FILEJTYPE;  LINE 

procedure 

B  LANK_L INE ( F ILE 

:  in  FILEJTYPE) ; 

procedure 

BLANK_LINE( LINE 

:  in  LINE_TYPE); 

procedure 

BLANK_LINE; 

generic 

in  LINEJTYPE); 


in  LINE_TYPE) ; 


type  NUM  is  range  <>,- 
package  INTEGER_PRINT  is 


procedure 


procedure 

procedure 

procedure 


PRINT (FILE 
LINE 
ITEM 
BRK 

PRINT (FILE 
ITEM 
BRK 

PRINT (LINE 
ITEM 
BRK 

PRINT (ITEM 
BRK 


in  FILEJTYPE; 
in  LINEJTYPE; 
in  NUM; 
in  BREAK_TYPE 
in  FILEJTYPE; 
in  NUM; 
in  BREAK_TYPE 
in  LINEJTYPE ; 
in  NUM; 
in  BREAK_TYPE 
in  NUM; 
in  BREAK  TYPE 


:  =  BREAK ) ; 


;  =  BREAK) ; 


procedure  PRINT (TO  :  out  STRING;  LAST 
end  INTEGER  PRINT; 


BREAK) ; 

BREAK ) ; 

out  NATURAL;  ITEM 


in  NUM) 


generic 

type  NUM  is  digits  <>; 


package  FLOAT_PRINT  is 

procedure 

PRINT (FILE 

in 

FILE_ 

TYPE; 

LINE 

in 

LINE  _ 

TYPE; 

ITEM 

in 

NUM.- 

BRK 

in 

BREAK 

_TYPE  :=  BREAK) 
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procedure  PRINT { FILE  :  in  FILE_TYPE; 

ITEM  :  in  NUM; 

BRK  :  in  BREAK_TYPE  :=  BREAK); 

procedure  PRINT (LINE  :  in  LINE_TYPE; 

ITEM  :  in  NUM; 

BRK  :  in  BREAK_TYPE  :*  BREAK); 

procedure  PRINT (ITEM  :  in  NUM; 

BRK  :  in  BREAKJTYPE  :=  BREAK); 

procedure  PRINT (TO  :  out  STRING;  LAST  :  out  NATURAL;  ITEM  :  in  NUM); 
end  FLOAT_PRINT; 

NULL_PHANTOM  :  constant  PHANTOM_TYPE ; 

LAYOUT_ERROR  :  exception  renames  TEXT_IO . LAYOUT_ERROR; 
private 

type  PHANTOM_TYPE  is  access  STRING; 


type  LINE_REC( LENGTH  :  INTEGER)  is 
record 

USED_YET  :  BOOLEAN 

INDENT  :  INTEGER 

CONT I NUAT I ONI NDENT  :  INTEGER 

INTEGER 
INTEGER 


BREAK 

INDEX 

DATA 

START_PHANTOM, 
END_PHANTOM 
end  record; 


=  FALSE; 
=  0; 

=  2; 

=  1; 

=  1; 


STRING ( 1 . .LENGTH) ; 


PHANTOM  TYPE  •.  =  NULL  PHANTOM; 


type  LINE_TYPE  is  access  LINE_REC ; 

NULL_PHANTOM  :  constant  PHANTOM_TYPE  :=  new  STRING' ("") ; 
end  TEXT_PRINT; 
package  body  TEXT_PRINT  is 
DEFAULT_LINE  :  LINE_TYPE; 

procedure  CREATE_LINE ( LINE  :  in  out  LINE_TYPE;  LENGTH  :  in  POSITIVE)  is 
begin 

LINE  :=  new  LINE_REC ( LENGTH ) ; 
end  CREATE_LINE; 

procedure  SET_LINE( LINE  :  in  LINE_TYPE)  is 
begin 
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DEFAULT_LINE  LINE; 
end  SET_LINE; 

function  CURRENT_LINE  return  LINE_TYPE  is 
begin 

return  DEFAULT_LINE ; 
end  CURRENT_LINE; 

procedure  SET_INDENT { LINE  :  in  LINE_TYPE;  INDENT  :  in  NATURAL)  is 

begin 

if  INDENT  >=  LINE. LENGTH  then 
raise  LAYOUT_ERROR ; 
end  if; 

if  LINE. INDEX  =  LINE. INDENT  +  1  then 
for  I  in  1.. INDENT  loop 
LINE . DATA ( I )  :=  '  '; 
end  loop; 

LINE. INDEX  :=  INDENT  +  1; 
end  if; 

LINE. INDENT  :=  INDENT; 
end  SET_ INDENT ; 

procedure  SET_INDENT ( INDENT  :  in  NATURAL)  is 
begin 

SET_INDENT ( DEFAULT_LINE , INDENT ) ; 
end  SET_INDENT; 

procedure  SET_CONTINUATION_INDENT ( LINE  :  in  LINE_TYPE; 

INDENT  :  in  INTEGER)  is 

begin 

if  LINE. INDENT  +  INDENT  >=  LINE. LENGTH  or  else  LINE. INDENT  +  INDENT  <  0 
then 

raise  LAYOUT_ERR0R ; 
end  if; 

LINE. CONTINUATION_INDENT  :=  INDENT; 
end  SET_CONT I NUAT I ON_I NDENT ; 

procedure  SET_CONTINUATION_INDENT( INDENT  :  in  INTEGER)  is 
begin 

SET_CONTINUATION_INDENT( DEFAULT_LINE, INDENT) ; 
end  SET_CONTINUATION_INDENT; 

function  MAKE_PHANTOM( S  :  STRING)  return  PHANTOM_TYPE  is 
begin 

return  new  STRING' (S); 
end  MA K E_P H ANT OM ; 

procedure  SET_PHANTOMS ( LINE  :  in  LINE_TYPE; 

START_PHANTOM, 

END_PHANTOM  :  in  PHANTOM_TYPE )  is 
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begin 

LINE . START_PHANTOM  START_PHANTOM; 

LINE .  END_PHANTOM  :  =»  END_PHANTOM; 
end  S ET_P HANT OM S ; 

procedure  SET_PHANTOMS(START_PHANTOM,  END_PHANTOM  :  in  PHANTOM_TYPE )  is 
begin 

SET_PHANTOMS(DEFAULT_LINE, START_PHANTOM,END_PHANTOM) ; 
end  SET  PHANTOMS; 


procedure  PRINT (FILE  :  in  FILE_TYPE; 

LINE  :  in  LINE_TYPE; 

ITEM  :  in  STRING; 

BRK  :  in  BREAK_TYPE  :=  BREAK)  is 
NEW_BREAK,  NEW_INDEX  :  INTEGER; 
begin 

if  LINE. INDEX  +  ITEM' LENGTH  +  LINE . END_PHANTOM' LENGTH  >  LINE. LENGTH  +  1 
then 

if  LINE. INDENT  +  LINE . CONTINUATION_INDENT  +  LINE . START_PHANTOM ' LENGTH  + 
LINE. INDEX  -  LINE. BREAK  +  ITEM' LENGTH  >  LINE. LENGTH  then 
raise  LAYOUT_ERROR; 
end  if; 

if  ITEM  =  "  "  and  then  LINE. END_PHANTOM. all  =  ""  then 
return ; 
end  if; 

PUT_LINE( FILE, LINE . DATA( 1 . . LINE . BREAK- 1 )  &  LINE . END_PHANTOM . all ) ; 
for  I  in  1 .. LINE . INDENT  +  LINE . CONTINUATION_INDENT  loop 
LINE . DATA ( I )  :=  '  '; 

end  loop; 

NEW_BREAK  : =  LINE. INDENT  +  LINE . CONTINUATION_INDENT  +  1; 

NEW_INDEX  :=  NEW_BREAK  +  LINE . START_PHANTOM' LENGTH  + 

LINE. INDEX  -  LINE. BREAK; 

LINE . DATA ( NEW_BREAK . . NEW_INDEX )  : =  LINE . START_PHANTOM .all  & 

LINE. DATA (LINE. BREAK. .LINE. INDEX) ; 

LINE. BREAK  :=  NEW_BREAK; 

LINE. INDEX  :=  NEW_INDEX; 
end  if; 

NEW_ INDEX  :=  LINE. INDEX  +  ITEM ' LENGTH ; 

LINE. DATA (LINE. INDEX. ,NEW_INDEX-1)  :  =  ITEM; 

LINE.  INDEX  :=  NEV?_INDEX; 
if  BRK  =  BREAK  then 

LINE. BREAK  :=  NEW_INDEX; 
end  if; 

LINE . USED_YET  :=  TRUE; 
end  PRINT; 


procedure  PRINT (FILE 
ITEM 
BRK 

begin 


in  FILE_TYPE; 
in  STRING; 

in  BREAK_TYPE  :  =  BREAK)  is 
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PRINT ( FILE, DEFAULT_LINE, ITEM, BRK) ; 
end  PRINT; 

procedure  PRINT (LINE  :  in  LINE_TYPE; 

ITEM  :  in  STRING; 

BRK  :  in  BREAKJTYPE  :=  BREAK)  is 

begin 

PRINT (CURRENTJMJTPUT, LINE, ITEM, BRK)  ; 
end  PRINT; 

procedure  PRINT (ITEM  :  in  STRING;  BRK  :  in  BREAK_TYPE  :=  BREAK)  is 
begin 

PRINT (CURRENT_OUTPUT,DEFAULT_LINE, ITEM, BRK) ; 
end  PRINT; 

procedure  PRINTLINE  (FILE  :  in  FILE_TYPE;  LINE  :  in  LINEJTYPE)  is 
begin 

if  LINE. INDEX  /=  LINE. INDENT  +  1  then 

PUT_LINE( FILE, LINE. DATA(1. . LINE . INDEX-1 ) ) ; 
end  if; 

for  I  in  1 . . LINE . INDENT  loop 
LINE . DATA ( I )  :=  '  '; 

end  loop; 

LINE. INDEX  :=  LINE. INDENT  +  1; 

LINE. BREAK  :=  LINE. INDEX; 
end  PRINT_LINE; 

procedure  PRINT_LINE ( FILE  :  in  FILEJTYPE)  is 
begin 

PRINT_LINE (FILE, DEFAULT_LINE ) ; 
end  PRINT_LINE ; 

procedure  PRINT_LINE ( LINE  :  in  LINE_TYPE)  is 
begin 

PRINTLINE  ( CURRENT_OUTPUT ,  LINE )  ; 
end  PRINT_LINE; 

procedure  PRINT^LINE  is 
begin 

PRINTLINE ( CURRENTJDUTPUT ,  DEFAULT_LINE )  ; 
end  PRINTLINE; 

procedure  BLANK_LINE (FILE  :  in  FILE_TYPE;  LINE  :  in  LINE_TYPE)  is 
begin 

if  LINE . USED_YET  then 
NEW_LINE ( FILE ) ; 
end  if; 

end  BLANK_LINE; 

procedure  BLANK_LINE( FILE  :  in  FILE_TYPE)  is 
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begin 

BLANK_LINE ( FILE , DEFAULT_LINE ) ; 
end  BLANK_LINE; 

procedure  BLANK_LINE(LINE  :  in  LINE_TYPE)  is 
begin 

BLANK_LINE ( CURRENT_OUTPUT , LINE ) ; 
end  BLANK_LINE ; 

procedure  BLANK_LINE  is 
begin 

BLANK_LINE ( CURRENT_OUTPUT , DEFAULT_LINE ) ; 
end  BLANK_LINE; 

package  body  INTEGER_PRINT  is 


procedure  PRINT (FILE  :  in  FILE_TYPE; 

LINE  :  in  LINE_TYPE; 

ITEM  :  in  NUM; 

BRK  :  in  BREAK_TYPE  :=  BREAK)  is 
S  :  STRING* 1. .NUM' WIDTH ) ; 

L  :  NATURAL; 
begin 

PRINT (S,L, ITEM) ; 

PRINT ( FILE , LINE , S ( 1 . .L) , BRK) ; 
end  PRINT; 


procedure  PRINT (FILE  :  in  FILE_TYPE; 

ITEM  :  in  NUM; 

BRK  :  in  BREAK_TYPE 

begin 

PRINT (FILE , DEFAULT_LINE , ITEM , BRK ) ; 
end  PRINT; 


in  FILEJTYPE; 
in  NUM; 

in  BREAK_TYPE  :=  BREAK)  is 


procedure  PRINT (LINE  :  in  LINE_TYPE; 

ITEM  :  in  NUM; 

BRK  :  in  BREAK_TYPE  :=  BREAK)  is 

begin 

PRINT ( CURRENT_OUTPUT , LINE , ITEM , BRK ) ; 
end  PRINT; 

procedure  PRINT (ITEM  :  in  NUM; 

BRK  :  in  BREAK_TYPE  :=  BREAK)  is 

begin 

PRINT ( CURRENT_OUTPUT , DEFAULTJLINE , ITEM , BRK ) ; 
end  PRINT; 

procedure  PRINT(TO  :  out  STRING;  LAST  :  out  NATURAL;  ITEM  :  in  NUM)  is 
S  :  constant  STRING  :=  NUM' IMAGE ( ITEM) ; 

F  :  NATURAL  : =  S' FIRST;  —  Bug  in  DG  Compiler  —  S' FIRST  /=!!!!!  !  ! 
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L  :  NATURAL; 
begin 

if  S(F)  -  '  '  then 
F  F  +  1; 
end  if; 

if  TO'  LENGTH  <  S' LAST  -  F  +  1  then 
raise  LAYOUT_ERROR; 
end  if; 

L  :*»  TO' FIRST  +  S'LAST  -  F; 

TO(TO' FIRST.  .L)  :=  S ( F . . S' LAST) ; 

LAST  :**  L; 
end  PRINT; 

end  INTEGER  PRINT; 


package  body  FLOAT_PRINT  is 

package  NUM_IO  is  new  FLOAT__IO(NUM) ; 
use  NUM_IO; 

procedure  PRINT(FILE  in  FILE_TYPE; 

LINE  :  in  LINEJTYPE; 

ITEM  :  in  NUM; 

BRK  :  in  BREAK_TYPE  :=  BREAK)  is 
S  :  STRING ( 1. . DEFAULT_FORE  +  DEF AULT_AFT  +  DEF AULT_EXP  +  2); 
L  :  NATURAL; 
begin 

PRINT ( S  ?  L , ITEM ) ; 

PRINT( FILE, LINE, S(l. . L ) , BRK ) ; 
end  PRINT; 


procedure  PRINT (FILE  :  in  FILE_TYPE; 

ITEM  :  in  NUM; 

BRK  :  in  BREAK_TYPE  :=  BREAK)  is 

begin 

PRINT ( FILE , DEFAULT_LINE , ITEM, BRK ) ; 
end  PRINT; 


procedure  PRINT (LINE  :  in  LINE_TYPE ; 

ITEM  :  in  NUM; 

BRK  :  in  BREAK_TYPE  :=  BREAK)  is 

begin 

PRINT ( CURRENT_OUTPUT , LINE , ITEM, BRK )  ; 
end  PRINT; 


procedure  PRINT ( ITEM  :  in  NUM; 

BRK  :  in  BREAKJTYPE  :=  BREAK)  is 

begin 

PRINT ( CURRENT_OUTPUT , DEFAULT_LINE , ITEM , BRK ) ; 
end  PRINT; 
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procedure  PRINT (TO  :  out  STRING/  LAST  :  out  NATURAL/  ITEM  :  in  NUM)  is 
S  :  STRING ( 1. . DEFAULT_FORE  +  DEFAULT_AFT  +  DEFAULT_EXP  +  2); 

EXP  :  INTEGER; 

E_INDEX  :  NATURAL  : ’  S' LAST  -  DEFAULT_EXP ; 

DOT_INDEX  :  NATURAL  : -  DEFAULT_FORE  +  1/ 

L  :  NATURAL; 

begin 

PUT(S,ITEM) / 

EXP  : =  INTEGER ' VALUE ( S ( E_INDEX+1 ..S'  LAST ) ) ; 
if  EXP  >»  0  then 

if  EXP  <=  DEFAULT_AFT-1  then 

S(DOT_INDEX. . D0T_INDEX+EXP~1 )  S ( D0T_INDEX+1 . . DOT_INDEX+EXP ) ; 

S(DOT_INDEX+EXP)  :»  '  .  '  ; 
for  I  in  E_INDEX ..S'  LAST  loop 
S(I)  :=  '  '; 
end  loop; 
end  if; 

else  —  EXP  <  0 

if  EXP  >=  -  (  DEFAULT_EXP  +  1  )  then 

S ( DEFAULT_EXP+  2..S'LAST)  :  -  S  ( 1 .  .  S ' LAST-DEFAULT_EXP- 1 ) ; 
for  I  in  1. . DEFAULT_EXP+1  loop 
S(I)  ••  =  '  '; 
end  loop; 

E_INDEX  :=  S' LAST  +  1; 

DOT_INDEX  :=  DOT_INDEX  +  DEFAULT_EXP  +  1; 

L  :=  DOT_INDEX+EXP ; 

for  I  in  reverse  L+l. ,DOT_INDEX  loop 
case  S(I-l)  is 

when  '  '  =>  S(I)  :=  'O'; 

when  '-'  =>  S(I-2)  :=  S(I)  :=  'O'; 

when  others  =>  S(I)  : =  S(I-l); 
end  case; 
end  loop; 

S(L)  :=  '.'; 
case  S(L-l)  is 

when  '  '  =>  S(L-l)  :=  'O'; 

when  '-'  =>  S ( L-2 )  :=  S(L-l)  :=  'O'; 

when  others  =>  null; 
end  case; 
end  if; 
end  if; 

for  I  in  reverse  l..E_INDEX-l  loop 

exit  when  S(I)  /=  '0'  or  else  S(I-l)  = 

S(I)  :=  '  ' ; 
end  loop; 

L  .=  0; 

for  I  in  S' RANGE  loop 
if  S(I)  /=  '  '  then 
L  ;=  L  +  1; 

TO ( L)  :=  S ( I ) ; 


i 
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end  if; 
end  loop; 

LAST  L; 
exception 

when  CONSTRAINT_ERROR  => 
raise  LAY0UT_ERR0R ; 
end  PRINT; 

end  FLOAT_PRINT; 

end  TEXT_PRINT; 


9.  Package  ADA_SQL_FUNCTION 


with  SYSTEM; 

package  DATABASE  is  —  *****  FOR  NOW,  FOR  TESTING  PURPOSES 

type  INTG  is  range  SYSTEM . MIN_INT  . .  SYSTEM . MAX_INT ; 

type  DOUBLE_PREC I SION  is  digits  SYSTEM. MAX_DIGITS; 
end  DATABASE; 


with  DATABASE; 

package  ADA_SQL_FUNCTIONS  is 
INTERNAL_ERROR  :  exception; 


type  SQL_OPERATION  is 
(  0_AVG 

0_UNARY_PLUS 

0_TIMES 

0_LT 

0_BETWEEN 

0_N0T 

0_SELECT_DISTINCT 
0_C0UNT_STAR 
0  VALUES 


t 

0_MAX 

r 

0_MIN 

t 

0_SUM 

f 

0_UNARY_MINUS 

t 

0_PLUS 

f 

0_MINUS 

/ 

0_DIVIDE 

t 

0_EQ 

f 

0_NE 

/ 

0_GT 

/ 

0_LE 

/ 

0_GE 

/ 

0_AND 

/ 

0_IS_IN 

t 

0_0R 

t 

0_LIKE 

/ 

0_AMPERSAND 

f 

0_SELEC 

r 

0_ASC 

/ 

0_DESC 

t 

0_TABLE_C0LUMN_LI ST 

f 

0_NULL_0P 

/ 

0_STAR 

t 

0_N0T_IN 

t 

0_DECLAR  > ; 

type  SQL_OBJECT 
type  TYPED_SQL_OBJECT 
type  TABLE_NAME 
type  TABLE_LIST 
type  INSERT_ITEM 
type  CUR SOR_NAME 
type  DATABASE_NAME 


is  private; 
is  private; 
is  private; 
is  private; 
is  private; 
is  private; 
is  private; 


NULL_SQL_OBJECT  :  constant  SQL_OBJECT; 


procedure  INITI ATE_TEST ;  —  *****  ONLY  FOR  TESTING 
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type  USERJTYPE  is  digits  <>; 

function  FLOAT_CONVERT  (  VAR  :  USERJTYPE  )  return  SQLJDBJECT; 
generic 

type  INDEXJTYPE  is  range  <>; 

type  USER_TYPE  is  array  (  INDEXJTYPE  range  <>  )  of  CHARACTER; 
function  UNCONSTRAINED_CHARACTER_STRING_CONVERT  (  VAR  :  USERJTYPE  ) 
return  SQL_OBJECT; 

generic 

type  INDEXJTYPE  is  range  <>; 

type  USERJTYPE  is  array  (  INDEXJTYPE  )  of  CHARACTER; 
function  CONSTRAINED_CHARACTER_STRING_CONVERT  (  VAR  :  USERJTYPE  ) 
return  SQL_OBJECT; 

generic 

type  INDEXJTYPE  is  range  <>; 
type  COMPONENT JTYPE  is  (<>); 

type  USERJTYPE  is  array  (  INDEXJTYPE  range  <>  )  of  COMPONENT  JTYPE ; 
with  function  CONVERT_COMPONENT_TO_CHARACTER  (  C  :  COMPONENT  JTYPE  ) 
return  CHARACTER  is  <>; 

function  UNCONSTRAINED_STRING_CONVERT  (  VAR  :  USERJTYPE  ) 
return  SQL_OBJECT; 

—  *****  must  generate  CONVERT_COMPONENT_TO_CHARACTER 
generic 

type  INDEXJTYPE  is  range  <  >  ; 
type  COMPONENT  JTYPE  is  (<>); 

type  USERJTYPE  is  array  (  INDEXJTYPE  )  of  COMPONENT  JTYPE ; 
with  function  CONVERT_COMPONENT_TO_CHARACTER  (  C  :  COMPONENT_TYPE  ) 
return  CHARACTER  is  <>; 

function  CONSTRAINED_STRING_CONVERT  (  VAR  :  USERJTYPE  ) 
return  SQL_OBJECT; 

—  column  and  table  name  routines 

generic 

GIVEN  JNAME  :  in  STANDARD . STRING; 
package  NAME_PACKAGE  is 

generic 

type  SQL_OBJECT JTYPE  is  private; 

with  function  CONVERT_R  (  R  :  SQL_OBJECT  )  return  SQL_OBJECT_TYPE  is  <>, 
function  COLUMN_OR_TABLE_NAME  return  SQL_OB JECT JTYPE; 

generic 

function  TABLE_NAME_WITH_COLUMN_LIST  (  COLUMNS  :  SQL_OBJECT  ) 
return  TABLE  NAME; 
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end  NAME_PACKAGE; 

—  *****  must  generate  routines  for  table. column  (define  record  structure) 

—  *****  must  generate  package  for  correlation . column  and  correlation. table 
■  value  specification  routines 

generic 

type  USER_TIPE  is  private; 
type  RESULT_TYPE  is  private; 

with  function  L_CONVERT  (  L  :  USER_TYPE  )  return  SQL_OBJECT  is  <>; 
with  function  CONVERT_R  (  R  :  SQL_OFJECT  )  return  RESULTJIYPE  is  <>; 
function  INDICATOR_FUNCTION  (  VAL  :  USER_TYPE  )  return  RESULT_TYPE; 

-  generic  operation  routines 

generic 

GIVEN_OPERATION  :  in  SQL_OPERATION; 
type  L_TYPE  is  private; 
type  TYPE_R  is  private; 

with  function  L_CONVERT  (  L  :  L_TYPE  )  return  SQL_OBJECT  is  <>; 
with  function  CONVERT_R  (  R  :  SQL_OBJECT  )  return  TYPE_R  is  <>; 
function  UNARY_OPERATION  (  L  :  L_TYPE  )  return  TYPE_R; 

generic 

GIVEN_ OPERATION  :  in  SQL_OPERATION; 
type  L_TYPE  is  private; 
type  R_TYPE  is  private; 
type  TYPE_R  is  private; 


with 

function 

L_CONVERT 

( 

L 

L_ 

TYPE 

) 

return 

SQL_ 

OBJECT 

is 

<>  ; 

with 

function 

RECONVERT 

( 

R 

R_ 

TYPE 

) 

return 

SQL_ 

OBJECT 

is 

<>  ; 

with 

function 

CONVERT_R 

( 

R 

SQL_OB JECT  )  return 

TYPE_R 

is 

<>; 

function  BINARY 

OPERATION 

< 

L 

L_ 

_TYPE 

t 

R  .-  R_ 

TYPE 

)  return 

TYPE_R 

-  set  function  routines 

—  *****  must  also  generate  STARJTYPE  is  function  COUNT  (  STARJTYPE  ) 

—  *****  instantiate  COUNT_STAR  for  DATABASE . INTG  or  untyped 

generic 

type  TYPE_R  is  private; 

with  function  CONVERT_R  (  R  :  SQL_OBJECT  )  return  TYPE_R  is  <>; 
function  COUNT_STAR  return  TYPE_R; 

—  instantiate  UNARY_OPERATION  for  0_AVG,  0_MAX,  0_MIN,  0_SUM 

-  value  expression  routines 

—  instantiate  UNARY_OPERATION  for  0_UNARY_PLUS ,  0_UNARY_MINUS 
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|  —  instantiate  BINARY_OPERATION  for  0_PLUS,  0_MINUS,  0_TIMES,  0_DIVIDE 

—  *****  generate  CONVERT_TO  package  for  type  conversions,  calling  CONVERT_R 

—  to  set  correct  result  type 

—  comparison  predicate  routines 

—  instantiate  BINARY_OPERATION  for  0_EQ,  0_NE,  0_LT,  0_GT,  0_LE,  0_GE 

—  between  predicate  routines 

—  instantiate  BINARY_OPERATION  for  0_BETWEEN 

|  —  instantiate  B I NAR Y_OPERAT ION  for  0_AND 

—  in  predicate  routines 

—  instantiate  B I NARY_0 P ERAT ION  for  0_IS_IN 

—  special  case  if  <in  value  list>  has  one  element 

—  instantiate  BINARY_OPERATION  for  0_0R 

—  different  instantiations  for  first  and  following  ORs 

—  instantiate  UNARY_OPERATION  for  0_N0T 

—  like  predicate  routines 

—  instantiate  BINARY_OPERATION  for  0_LIKE 

—  instantiate  UNARY_OPERATION  for  0_N0T 

—  search  condition  routines 

—  instantiate  BINARY_OPERATION  for  0_AND ,  0_0R 

—  instantiate  UNARY_OPERATION  for  0_N0T 

—  from  clause  routines 

—  instantiate  BINARYJOPERATION  for  0_AMPERSAND 

—  group  by  clause  routines 

—  instantiate  BINARY_OPERATION  for  0_AMPERSAND 

—  subquery  routines 
generic 
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SELECT_TYPE  :  in  SQL_OPERATION; 
type  WHAT_TYPE  is  private; 
type  TYPE_R  is  private; 

with  function  L_CONVERT  (  L  :  WHATJIYPE  )  return  SQL_OBJECT  is  <>; 
with  function  CONVERT_R  (  R  :  SQL_OBJECT  )  return  TYPE_R  is  <>; 
function  SELECT_LIST_SUBQUERY 


(  WHAT 
FROM 
WHERE 
GROUP_BY 
HAVING 


WHAT_TYPE  ; 
TABLE_LIST; 
SQL_OBJECT 
SQL_OBJECT 
SQL  OBJECT 


=  NULL_SQL_OB JECT  ; 

=•  NJLL_SQL_OB  JECT ; 

=  NULL_SQL_OBJECT  )  return  TYPE_R; 


generic 

SELECT_TYPE  :  in  SQL_OPERATION; 
type  TYPE_R  is  private; 

with  function  CONVERT_R  (  R  :  SQL_OBJECT  )  return  TYPEJR  is  <>; 
function  STAR  SUBQUERY 


(  FROM 
WHERE 
GROUP_BY 
HAVING 


TABLE_LIST; 
SQL_OBJECT 
SQL_OBJECT 
SQL  OBJECT 


=  NULL_SQL_OB JECT ; 

*  NULL_SQL_OB JECT ; 

=  NULL_SQL_OBJECT  )  return  TYPE_R; 


—  query  specification  routines 


—  instantiate  appropriate  subquery  routines 

—  also  instantiate  BINARY  OPERATION  for  0  AMPERSAND 


—  close  routine 


procedure  CLOSE  (  CURSOR  :  in  out  CURSOR_NAME  ) ; 


—  declare  cursor  routines 


procedure  DECLAR 

(  CURSOR 
CURSOR_FOR 
ORDER  BY 


in  out  CURSOR_NAME; 
in  SQL_OB JECT ; 

in  SQL_OBJECT  : =  NULL_SQL_OBJECT  ) ; 


—  instantiate  BINARY_OPERATICN  for  0_AMPERSAND 

—  instantiate  UNARY_OPERAT IOi  for  0_ASC  and  0_DESC 

—  delete  routines 

procedure  DELETE_FROM 

(  TABLE  :  in  TABLE_NAME; 

WHERE  :  in  SQL_OBJECT  : =  NULL_SQL_OBJECT  ) ; 

—  fetch  and  into  routines 
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procedure  FETCH  (  CURSOR  :  in  out  CURSOR_NAME  ) ; 
generic 

type  USER_TYPE  is  (<>); 

procedure  INTEGER_AND_ENUMERATION_INTO  {  VAR  :  out  USER_TYPE  ) ; 
generic 

type  USER_TYPE  is  digits  <>; 
procedure  FLOAT_INTO  (  VAR  :  out  USER_TYPE  ); 

generic 

type  INDEX_TYPE  is  range  <>; 
type  COMPONENT_TYPE  is  ( <  > ) ; 

type  USERJTYPE  is  array  <  INDEX_TYPE  range  <>  )  of  COMPONENTJTYPE , 
with  function  CONVERT_CHARACTER_TO_COMPONENT  (  C  :  CHARACTER  ) 
return  COMPONENT_TYPE  is  <>; 
procedure  UNCONSTRAINED_STRING_INTO 

(  VAR  :  out  USERJTYPE  ;  LAST  :  out  INDEXJTYPE  ) ; 

—  *****  must  generate  CONVERT  JSHARACTER_TO_COMPONENT 
generic 

type  INDEXJTYPE  is  range  <>; 
type  COMPONENTJTYPE  is  ( <  > ) ; 

type  USER_TYPE  is  array  (  INDEX_TYPE  )  of  COMPONENT_TYPE ; 
with  function  CONVERT_CHARACTER_TO_COMPONENT  (  C  :  CHARACTER  ) 
return  COMPONENTJTYPE  is  <>; 
procedure  CONSTRAINED_STRING_INTO 

(  VAR  :  out  USER_TYPE  ;  LAST  :  out  INDEX_TYPE  ) ; 

—  insert  into  routines 

procedure  INSERT_INTO 

(  TABLE  :  in  TABLE_NAME; 

WHAT  :  in  INSERT_ITEM  ) ; 

—  instantiate  BINARY_OPERATION  for  0_AMPERSAND 

—  see  table  name  routines  for  table  (  column  list  ) 
function  VALUES  return  INSERT_ITEM; 

—  instantiate  BINARY_OPERATION  for  0_LE  and  0_AND 

-  -  open  routine 

procedure  OPEN  (  CURSOR  :  in  out  CURSOR_NAME  ) , 

--  select  statement  routines 
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—  see  above  for  fetch  and  into  routines 
generic 

SELECT_TYPE  :  in  SQL_OPERATION; 
type  WHAT_TYPE  is  private; 

with  function  L_CONVERT  (  L  :  WHAT_TYPE  )  return  SQL_OBJECT  is  <>; 
procedure  SELECT_L I ST_SELECT 


(  WHAT 
FROM 
WHERE 
GROUP_BY 
HAVING 


in  WHAT_TYPE; 
in  TABLE_LIST; 
in  SQL_OBJECT 
in  SQL_OBJECT 
in  SQL  OBJECT 


-  NULL_SQL_OB JECT ; 

=  NULL_SQL_OB JECT ; 

=  NULL_SQL_OBJECT  ); 


generic 

SELECT_TYPE  :  in  SQL_OPERATION; 
procedure  STAR_SELECT 

(  FROM  :  in  TABLE_LIST; 

WHERE  :  in  SQL_OBJECT 

GROUP_BY  :  in  SQL_OBJECT 

HAVING  :  in  SQL  OBJECT 


-  NULL_SQL_OB JECT ; 

=  NULL_SQL_OB JECT ; 

=  NULL_SQL_OBJECT  ) ; 


-  update  routines 

procedure  UPDATE 
(  TABLE 
SET 
WHERE 


in  TABLE_NAME; 
in  SQL_OB JECT ; 

in  SQL_OBJECT  : =  NULL_SQL_OBJECT  ) ; 


—  instantiate  BINARY_OPERATION  for  0_AND 

—  instantiate  BINARY_OPERATION  for  0_LE 
private 

type  DATABASE_NAME  is  access  STANDARD . STRING; 
type  ACCESS_STRING  is  access  STANDARD. STRING; 

type  SQL_VALUE_KIND  is  (  INTEGER  ,  FLOAT  ,  STRING  ) ; 

type  SQL_VALUE  (  KIND  :  SQL_VALUE_KIND  : =  INTEGER  )  is 
record 

case  KIND  is 

when  INTEGER  => 

INTEGER  :  DATABASE . INTG ; 
when  FLOAT  => 

FLOAT  :  DATABASE. DOUBLE_PRECISION; 
when  STRING  => 

STRING  :  ACCESS_STRING ; 
end  case; 
end  record; 
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type  SQL_OBJECT_KIND  is  (  NAME  ,  VALUE  ,  OPERATION  ) ; 

type  SQL_OBJECT_RECORD  (  KIND  :  SQL_OBJECT_KIND  ); 
type  TYPED_SQL_OBJECT  is  access  SQL_OB JECT_RECORD ; 
type  SQL_OBJECT  is  new  TYPED_SQL_OBJECT ; 
type  TABLE_NAME  is  new  TYPED_SQL_OB JECT ; 
type  TABLE_LIST  is  new  TYPED_SQL_OBJECT ; 
type  INSERT_ITEM  is  new  TYPED_SQL_OBJECT ; 

type  SQL_OBJECT_RECORD  (  KIND  :  SQL_OBJECT_KIND  )  is 
record 

ACROSS  :  SQL_OB JECT ; 
case  KIND  is 
when  NAME  => 

NAME  :  DATABASE_NAME; 
when  VALUE  => 

VALUE  :  SQL_VALUE; 
when  OPERATION  => 

OPERATION  :  SQL_OPERATION; 

OPERANDS  :  SQL_OBJECT; 
end  case; 
end  record; 

NULL_SQL_OBJECT  :  constant  SQL_OBJECT  :=  null; 

type  CURSOR__NAME  is  new  SQL_OBJECT;  —  *****  FOR  NOW,  FOR  TESTING  PURPOSES 

end  ADA_SQL_FUNCTIONS ; 

with  ADA_SQL_FUNCTIONS; 
package  CURSOR_DEFINITION  is 

subtype  CURSOR_NAME  is  ADA_SQL_FUNCTIONS . CURSOR_NAME; 
end  CURSOR_DEFINITION; 

with  TEXT_PRINT ; 
use  TEXT_PRINT ; 

package  body  ADA_SQL_FUNCTIONS  is 

INDENT  :  STANDARD . INTEGER; 

package  DOUBLE_PRECISION_PRINT  is  new 
FLOAT_PRINT  (  DATABASE . DOUBLE_PRECISION  ); 

package  INTG_PRINT  is  new  INTEGER_PRINT  (  DATABASE . INTG  ) ; 

use  DOUBLE_PRECISION_PRINT  ,  INTG_PRINT ; 

LINE  :  LINE_TYPE; 

—  declarations  for  print  routines  (since  some  are  recursive  and  mutually 
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—  recursive) 

procedure  SH( 
procedure  SH( 
procedure  SH( 
procedure  SH( 
procedure  SH( 
procedure  SH( 
procedure  SH< 
procedure  SH( 
procedure  SH< 
procedure  SH( 
procedure  SH( 
procedure  SH( 
procedure  SH< 
procedure  SH( 
(  i 

procedure  SH( 


_VALUE_SPECIFICATION  ( 

_ALL_SET_FUNCT ION  ( 

_VALUE_EXP RES SION  ( 

_BETWEEN_PREDICATE  ( 

_IN_VALUE_LI ST  ( 

_LIKE_PREDICATE  ( 

_SEARCH_CONDITION  ( 

_TABLE_EX1’RESSI0N  { 

_QUERY_SPECIFICATION  ( 

_SELECT_L 1ST  ( 

_ORDER_BY_CLAUSE  ( 

_INSERrp_VALUE_LIST  ( 

_SET_CLAUSES  ( 

_COMPARI SON_PRED IC ATE 
:  in  SQL_OBJECT  ;  P  : 
_IN_PREDICATE 
:  in  SQL  OBJECT  ;  P  : 


( 

S  : 

in 

SQL. 

.OBJECT 

) 

( 

S  : 

in 

SQL. 

.OBJECT 

) 

( 

S  : 

in 

SQL. 

.OBJECT 

) 

( 

S  : 

in 

SQL. 

.OBJECT 

) 

( 

S  : 

in 

SQL. 

.OBJECT 

) 

( 

S  : 

in 

SQL. 

.OBJECT 

) 

( 

S  : 

in 

SQL. 

.OBJECT 

) 

{ 

S  : 

in 

SQL. 

.OBJECT 

) 

( 

S  : 

in 

SQL. 

.OBJECT 

) 

( 

S  : 

in 

SQL. 

.OBJECT 

) 

( 

S  : 

in 

SQL. 

.OBJECT 

) 

( 

S  : 

in 

SQL. 

.OBJECT 

) 

( 

S  : 

in 

SQL. 

.OBJECT 

) 

STANDARD . STRING  ); 


STANDARD . STRING  ); 


procedure  INITIATE_TEST  is  —  *****  FOR  TESTING  ONLY 
begin 

CREATE_LINE  (  LINE  ,  79  ); 

SET_LINE  (  LINE  ) ; 

SET_CONTINUATION_INDENT  (  7  ); 
end  INITIATE_TEST ; 

—  constant  literal  value  generator 

function  CONSTANT_LITERAL  return  RESULT_TYPE  is 
begin 

return  VALUE; 
end  CONSTANT_LITERAL; 

—  conversion  routines  for  SQL  objects 

function  L_CONVERT  (  L  :  TYPED_SQL_OBJECT  )  return  SQL_OBJECT  is 
begin 

return  SQL_OBJECT  (  L  ) ; 
end  L_CONVERT; 

function  CONVERT_R  (  R  :  SQL_OBJECT  )  return  TYPED_SQL_OBJECT  is 
begin 

return  TYPED_SQL_OBJECT  (  R  ) ; 
end  CONVERT_R; 

package  body  CONVERT  is 

function  L_CONVERT  (  L  :  SQL_OBJECT  )  return  SQL_OBJECT  is 
begin 
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return  L; 
end  L  CONVERT; 


function  L_CONVERT  (  L  :  TABLE_NAME  )  return  SQL_OBJECT  is 
begin 

return  SQL_OBJECT  (  L  ) ; 
end  L  CONVERT; 


function  CONVERT_R  (  R  :  SQL_OBJECT  )  return  TABLE_NAME  is 
begin 

return  TABLE_NAME  (  R  ) ; 
end  CONVERT  R; 


function  L_CONVERT  (  L  :  TABLE_LIST  )  return  SQL_OBJECT  is 
begin 

return  SQL_OBJECT  (  L  ) ; 
end  L  CONVERT; 


function  CONVERT_R  (  R  :  SQL_OBJECT  )  return  TABLE_LIST  is 
begin 

return  TABLE_LIST  (  R  ) ; 
end  CONVERT_R; 


function  L_CONVERT  (  L  :  INSERT_ITEM  )  return  SQL_OBJECT  is 
begin 

return  SQL_OBJECT  (  L  ) ; 
end  L  CONVERT; 


function  CONVERT_R  (  R  :  SQL_OBJECT  )  return  INSERT_ITEM  is 
begin 

return  INSERT_ITEM  (  R  ) ; 
end  CONVERT  R; 


end  CONVERT; 


—  conversion  routines  for  user  types 


function  INTEGER_AND_ENUMERATION_CONVERT  (  VAR  :  USER_TYPE  ) 
return  SQL_OBJECT  is 
begin 
return 

new  SQL_OB JECT_RECORD ' 

(  VALUE  ,  null  ,  (  INTEGER  ,  USER_TYPE ' POS  (  VAR  )  )  ); 

end  INTEGER  AND  ENUMERATION  CONVERT; 


function  FLOAT_CONVERT  (  VAR  :  USER_TYPE  )  return  SQL_OBJECT  is 
begin 
return 

new  SQL_OBJECT_RECORD ' 

{  VALUE  ,  null  ,  (  FLOAT  ,  DATABASE . DOUBLE_PRECISION  (  VAR  )  )  ) 
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end  FLOAT_CONVERT ; 

function  UNCONSTRAINED_CHARACIER_STRING_CONVERT  (  VAR  :  USER_TYPE  ) 
return  SQL_OBJECT  is 

S  :  ACCES S_STRING  new  STANDARD . STRING  (  1  ..  VAR' LENGTH  ); 
begin 

S . all  STANDARD . STRING  (  VAR  ); 

return  new  SQL_OB JECT_RECORD '  (  VALUE  ,  null  ,  (  STRING  ,  S  )  ); 
end  UNCONSTRAINED_CHARACTER_STRING_CONVERT ; 

function  CON STRAINED_CHARACTER_ST RI NG_CONVERT  (  VAR  :  USERJTYPE  ) 
return  SQL_OBJECT  is 

S  :  ACCESS_STRING  :=  new  STANDARD . STRING  (  1  ..  VAR 'LENGTH  ); 
begin 

S . all  :=  STANDARD . STRING  (  VAR  ); 

return  new  SQL_OB JECT_RECORD '  (  VALUE  ,  null  ,  (  STRING  ,  S  )  ); 
end  CONSTRAINED_CHARACTER_STRING_CONVERT ; 

function  UNCONSTRAINED_STRING_CONVERT  (  VAR  :  USERJTYPE  ) 
return  SQL_OBJECT  is 

S  :  ACCESS_STRING  :=  new  STANDARD . STRING  (  1..  VAR 'LENGTH  ); 

I  :  POSITIVE  :=  1; 

begin 

for  J  in  VAR' RANGE  loop 

S(I)  :=  CONVERT_COMPONENT_TO_CHARACTER  (  VAR(J)  ) ; 

I  :=  I  +  1; 
end  loop; 

return  new  SQL_OB JECT_RECORD '  (  VALUE  ,  null  ,  (  STRING  ,  S  )  ); 
end  UNCONSTRAINED_STRING_CONVERT ; 

function  CON STRAINED_STRING_CONVERT  (  VAR  :  USERJTYPE  ) 
return  SQL_OBJECT  is 

S  :  ACCESS JSTRING  :=  new  STANDARD . STRING  (  1..  VAR 'LENGTH  ); 

I  :  POSITIVE  :=  1; 

begin 

for  J  in  VAR' RANGE  loop 

S(I)  :=  CONVERT_COMPONENT_TO_CHARACTER  (  VAR(J)  ); 

I  :=  I  +  1; 
end  loop,- 

return  new  SQL_OBJECT_RECORD '  (  VALUE  ,  null  ,  (  STRING  ,  S  )  ); 
end  CONSTRAINED_STRING_CONVERT ; 

—  column  and  table  neune  routines 

package  body  NAME_PACKAGE  is 

NAME_P  :  constant  DATABASE_NAME  :=  new  STANDARD . STRING'  (  GIVEN_NAME  ) 

function  COLUMN JIRJT ABLE JJAME  return  SQL_OBJECT_TYPE  is 
begin 
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return  C0NVERT_R  (  new  SQL  J)B JECT_RECORD '  (  NAME  ,  null  ,  NAME_P  )  ); 
end  COLUMN J)R_TABLE_NAME; 

function  TABLE_NAME_WITH_COLUMN_LIST  (  COLUMNS  :  SQL_OBJECT  ) 
return  TABLE_NAME  is 

N  :  SQLJDBJECT  new  SQL  J3B JECT_RECORD '  (  NAME  ,  COLUMNS  ,  NAME_P  ); 
begin 
return 

new  SQL_OB JECT_RECORD ’  (  OPERATION  ,  null  ,  0_TABLE_C0LUMN_LI ST  ,  N  ); 
end  TABLE_NAME_WITH_COLUMN_LIST; 

end  NAME_PACKAGE ; 

—  value  specification  routines 

function  INDICATOR_FUNCTION  (  VAL  :  USERJTYPE  )  return  RESULTJTYPE  is 
begin 

return  CONVERT_R  (  L_CONVERT  (  VAL  )  )  ; 
end  INDICATORJFUNCTION; 

—  generic  operation  routines 

function  UNARY_OPERATION  (  L  :  L_TYPE  )  return  TYPE_R  is 
begin 
return 
CONVERT_R 

(  new  SQL_OB JECT_RECORD ' 

(  OPERATION  ,  null  ,  GIVEN_OPERATION  ,  L_CONVERT  (  L  )  )  ); 
end  UNARY_OPERATION; 

function  BINARYJDPERATION  (  L  :  L_TYPE  ;  R  :  R_TYPE  )  return  TYPE_R  is 
LEFT  :  SQL_OBJECT  :  =  L_CONVERT  (  L  )  ; 
begin 

LEFT . ACROSS  : =  R_CONVERT  (  R  ) ; 
return 
CONVERT_R 

(  new  SQL_OB JECT_RECORD '  (  OPERATION  ,  null  ,  GIVEN_OPERATION  ,  LEFT  )  ) 

end  BINARYJDPERATION; 

—  set  function  routines 

function  CO’JNT_STAR  return  TYPE_R  is 
begin 
return 
CONVERT_R 

(  new  SQL_OB JECT_RECORD '  (  OPERATION  ,  null  ,  0_C0UNT_STAR  ,  null  )  ); 

end  COUNT_STAR; 

—  subquery  routines 
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function  NEWJTAIL  (  L  ,  R  :  SQL_OBJECT  )  return  SQL_OBJECT  is 
begin 

if  R  *  null  then 
L. ACROSS  :« 

new  SQL_OB JECT_RECORD '  (  OPERATION  ,  null  ,  0_NULL_0P  ,  null  ); 
else 

L.  ACROSS  :=*  R; 
end  if; 

return  L. ACROSS; 
end  NEW  TAIL; 


function  BUILD_SELECT 

(  SELECT_TYPE  :  SQL_OPERATION; 

WHAT  :  SQL_OB  JECT  ; 

FROM  i  TABLE_LIST; 

WHERE  ,  GROUP_BY  ,  HAVING  :  SQL_OBJECT  ) 

return  SQL_OBJECT  is 
TAIL  :  SQL_OBJECT  := 

NEW_TAIL 
(  NEW_TAIL 

(  NEW_TAIL  (  SQL_OBJECT  (  FROM  )  ,  WHERE  )  ,  GROUP_BY  )  ,  HAVING  ); 

begin 

WHAT. ACROSS  :=  SQL_OBJECT  (  FROM  ); 

return  new  SQL_OB JECT_RECORD '  (  OPERATION  ,  null  ,  SELECT_T YP E  ,  WHAT  ); 
end  BUILD_SELECT; 

function  SELECT_LIST_SUBQUERY 

(  WHAT  :  WHATJTYPE; 

FROM  :  TABLE_LIST; 

WHERE  :  SQL_OBJECT  :=  NULL_SQL_OB JECT ; 

GROUP_BY  :  SQL_OBJECT  :=  NULL_SQL_OB JECT ; 

HAVING  ••  SQL_OBJECT  :=  NULL_SQL_OBJECT  )  return  TYPE_R  is 

begin 
return 
CONVERT_R 
(  BUILD_SELECT 
(  SELECTJTYPE, 

L_CONVERT  (  WHAT  )  ,  FROM  ,  WHERE  ,  GROUP_BY  ,  HAVING  )  ) ; 

end  SELECT  LIST  SUBQUERY; 


=  NULL_SQL_OB JECT ; 

=  NULL_SQL_OB JECT ; 

=  NULL_SQL_OBJECT  )  return  TYPE_R  is 


function  STAR_SUBQUERY 
(  FROM  :  1 

WHERE  :  £ 

GROUP_BY  :  £ 

HAVING  :  £ 

begin 
return 
CONVERT_R 
(  BUILD_SELECT 
(  SELECT_TYPE, 


TABLE_LIST; 
SQL_OBJECT 
SQL_OBJECT 
SQL  OBJECT 


=  NULL_SQL_OB JECT ; 

=  NULL_SQL_OB JECT ; 

=  NULL_SQL_OBJECT  )  return  TYPE_R  is 
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new  SQL_OB JECT_RECORD '  (  OPERATION  ,  null  ,  0_STAR  ,  null  ) , 
FROM  ,  WHERE  ,  GROUP_BY  ,  HAVING  )  ); 
end  STAR_SUBQUERY; 

-  print  routines 

—  5.6.1  <value  specif ication> 

procedure  SHOW_VALUE_SP  EC I F ICAT I ON  (  S  :  in  SQL_OBJECT  )  is 
begin 

case  S. VALUE. KIND  is 

when  INTEGER  =>  PRINT  (  S . VALUE . INTEGER  ); 
when  FLOAT  =>  PRINT  (  S . VALUE . FLOAT  ); 

when  STRING  =>  PRINT  (  S  S . VALUE. STRING . all  &  ); 

end  case; 

end  SHOW_VALUE_SPECIFICATION; 

—  5.8.3  <all  set  function) 

procedure  SHOW_ALL_SET_FUNCTION  (  S  :  in  SQL_OBJECT  ;  is 
begin 

case  S. OPERATION  is 


K 

when 

0_AVG 

=  > 

PRINT 

( 

"AVG(  "  )  ; 

& 

when 

0_MAX 

=  > 

PRINT 

( 

"MAX(  "  ) ; 

■ 

when 

0_MIN 

=  > 

PRINT 

( 

"MIN (  "  ) ; 

1 

when 

0_SUM 

=  > 

PRINT 

( 

"SUM(  "  ); 

& 

when 

others 

=  > 

raise 

INTERNAL  ERROR 

end  case; 

SHOW_VALUE_EXPRESSION  (  S . OPERANDS  ); 

PRINT  (  "  ) "  ) ; 
end  SHOW_ALL_SET_FUNCTION; 

—  5.9.1  <value  expression) 

procedure  P ARENTHES I Z E_ADD ING_OP ERAND S 

(  S  :  in  SQL_OBJECT  ;  P  :  in  STANDARD . STRING  )  is 

begin 

SHOW_VALUE_EXP RES SION  (  S  ) ; 

PRINT  (  P  )  ; 

if  S . ACROSS . KIND  =  OPERATION  then 
case  S. ACROSS. OPERATION  is 

when  0_UNARY_MINUS  |  0_PLUS  |  0_MINUS  => 

PRINT  (  "(  "  )  ; 

SHOW_VALUE_EXPRESSION  (  S . ACROSS  ); 

PRINT  (  "  ) "  )  ; 

when  others  => 

SHOW_VALUE_EXPRESSION  (  S . ACROSS  ); 
end  case; 
else 

SHOW_VALUE_EXPRESSION  (  S. ACROSS  ); 
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end  if; 

end  PARENTHESIZE_ADDING_OPERANDS; 

procedure  PARENTHESIZE_MULTIPLYING_OPERANDS 

(  S  :  in  SQL_OBJECT  ;  P  :  in  STANDARD . STRING  )  is 

begin 

if  S .  KIND  =*  OPERATION  then 
case  S. OPERATION  is 

when  0_UNARY_MI NU S  |  0_PLUS  |  0_MINUS  => 

PRINT  (  "(  "  ) ; 

SHOW_VALUE_EXP RES SION  (  S  )  ; 

PRINT  (  "  ) "  )  ; 
when  others  =*> 

SHOW_VALUE_EXP RE S  S ION  (  S  ); 
end  case; 
else 

SHOW_VALUE_EXPRESSION  (  S  ); 
end  if; 

PRINT  (  P  ); 

if  S . ACROSS . KIND  =  OPERATION  then 
case  S . ACROSS . OPERATION  is 

when  0_UNARY_MINUS  |  0_PLUS  |  0_MINUS  |  0_TIMES  |  0_DIVIDE  => 
PRINT  (  "{  "  ); 

SHOW_VALUE_EXPRESSION  (  S . ACROSS  ) ; 

PRINT  (  "  ) "  )  ; 

when  others  => 

SHOW_VALUE_EXPRESSION  (  S. ACROSS  ); 
end  case; 
else 

SHOW_VALUE_EXPRESSION  (  S . ACROSS  ) ; 
end  if; 

end  PARENTHESIZE_MULTIPLYING_OPERANDS; 

procedure  SHOW_VALUE_EXPRESSION  (  S  :  in  SQL_OBJECT  )  is 
begin 

case  S.KIND  is 
when  VALUE  => 

SHOW_VALUE_SPECIFICATION  (  S  ); 
when  NAME  => 

PRINT  (  S . NAME . all  ) ; 
when  OPERATION  => 
case  S. OPERATION  is 

when  0_AVG  |  0_MAX  |  0_MIN  |  0_SUM  => 

SHOW_ALL_SET_FUNCTION  (  S  )  ; 
when  0_C0UNT_STAR  => 

PRINT  (  "COUNT ( * ) "  ) ; 
when  0  UNARY  PLUS  => 


SHOW_VALUE_EXPRESSION  (  S . OPERANDS  ) ; 
when  0_UNARY_MINUS  => 

PRINT  (  "  -  "  ) ; 
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if  S . OPERANDS . KIND  =  OPERATION  then 
case  S . OPERANDS . OPERATION  is 

When  0_UNARY_MINUS  |  0_PLUS  |  0_MINUS  |  0_TIMES  |  0_DIVIDE  => 
PRINT  (  "(  "  ) ; 

SHOW_VALUE_EXPRESSION  (  S . OPERANDS  ); 

PRINT  (  "  )M  ) ; 

When  others  =>  SHOW_VALUE_EXPRESSION  (  S. OPERANDS  ); 
end  case; 
else 

SHOW_V ALUE_EXP RE S S I ON  (  S . OPERANDS  ); 
end  if; 

when  0_PLUS  => 

PARENTHES I Z  E_ADDING_OP  ERAND  S  (  S . OPERANDS  ,  "  +  "  ); 
when  0_MINUS  =  > 

PARENTHESIZE_ADDING_OPERANDS  (  S . OPERANDS  ,  "  -  "  ); 
when  OJTIMES  => 

PARENTHESIZE_MULTIPLYING_OPERANDS  (  S . OPERANDS  ,  "  *  "  ); 
when  0_DIVIDE  =  > 

PARENTHESIZE_MULTIPLYING_OPERANDS  (  S . OPERANDS  ,  "  /  "  ); 
when  others  =>  raise  INTERNAL_ERROR; 
end  case,- 
end  case; 

end  SHOW_VALUE_EXPRESSION; 

—  5.11.1  Comparison  predicate) 

procedure  SHOW_COMPARISON_PREDICATE 

(  S  :  in  SQL_OBJECT  ;  P  :  in  STANDARD . STRING  )  is 

begin 

SHOW_VALUE_EXPRESSION  (  S  ) ; 

PRINT  (  P  ) ; 

if  S . ACROSS . KIND  =  OPERATION  then 
case  S. ACROSS. OPERATION  is 

when  0_SELEC  |  0_SELECT_DISTINCT  => 

SHOW_QUERY_SPEC I F I CATION  (  S . ACROSS  ); 
when  others  => 

SHOW_VALUE_EXPRESSION  (  S . ACROSS  ); 
end  case; 
else 

SHOW_VALUE_EXPRESSION  (  S. ACROSS  ); 
end  if; 

end  SHOW_COMPARISON_PREDICATE; 

—  5.12.1  <between  predicate) 

procedure  SHOW_BETWEEN_PREDICATE  (  S  :  in  SQL_OBJECT  )  is 

OPERAND  :  SQL_OBJECT  : =  S . ACROSS . OPERANDS ;  —  first  operand  of  AND 
begin 

SHOW_VALUE_EXPRESSION  (  S  )  ; 

PRINT  (  "  BETWEEN  "  ) ; 
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SHOW_VALUE_EXP RE  S S I ON  (  OPERAND  ); 

PRINT  (  "  AND  "  ) ; 

SHOW_VALUE_EXPRE S S I ON  (  OPERAND . ACROSS  ); 
end  SHOW_BETWEEN_PREDICATE; 

—  5.13.1  <in  predicate) 

procedure  SHOW_IN_PREDICATE 

(  S  :  in  SQL_OBJECT  ;  P  :  in  STANDARD . STRING  )  is 

begin 

PRINT  (  P  ) ; 

SHOW_VALUE_EXPRESS I ON  (  S  )  ; 

PRINT  (  "  IN  "  ) ; 

if  S . ACROSS . KIND  =  OPERATION  then 
case  S . ACROSS . OPERATION  is 

when  0_SELEC  |  0_SELECT_DISTINCT  => 

SHOW_QUERY_SPECIFICATION  (  S. ACROSS  ); 
return; 

when  others  => 
null ; 
end  case; 
end  if; 

PRINT  (  "<  "  );  SHOW_IN_VALUE_LIST  (  S. ACROSS  );  PRINT  (  "  >"  ); 
end  SHOW_IN_PREDICATE; 

—  5.13.2  <in  value  list) 

procedure  SHOW_IN_VALUE_LIST  (  S  :  in  SQL_OBJECT  )  is 
begin 

case  S . KIND  is 
when  VALUE  => 

SHOW_VALUE_S PEC I F IC AT ION  (  S  ); 
when  OPERATION  => 

if  S. OPERATION  /=  0_0R  then 
raise  INTERNAL_ERROR ; 
end  if; 

SHOW_IN_VALUE_LIST  (  S. OPERANDS  ); 

PRINT  (  ",  "  )  ; 

SHOW_IN_VALUE_LI ST  (  S . OPERANDS . ACROSS  ); 
when  others  => 

raise  INTERNAL_ERROR ; 
end  case; 

end  SHOW_IN_VALUE_LIST; 

—  5.14.1  <like  predicate) 

procedure  SHOW_LIKE_PREDICATE  (  S  :  in  SQL_OBJECT  )  is 

P  :  ACCESS_STRING  :=  S . ACROSS . VALUE . STRING ;  —  must  be  of  right  type 
begin 

PRINT  (  S. NAME. all  ' •  PRINT  (  "  =  "  ); 
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for  I  in  P' RANGE  loop 
case  P(I)  is 

when  =>  P(I) 

when  '%'  ->  P(I) 

when  others  ->  null; 
end  case; 
end  loop; 

SHOW_VALUE_SPECIFICATION  (  S. ACROSS  ); 
end  SHOW_LIKE_PREDICATE; 

—  5.18.1  <search  condition) 

procedure  PARENTHESI ZE_RELATIONAL_OPERATORS 

(  S  :  in  SQL_OBJECT  ;  P  :  in  STANDARD . STRING  )  is 
OPERAND  :  SQL_OBJECT  :=  S. OPERANDS; 
begin 

case  OPERAND. OPERATION  is  —  must  be  operation 
when  0_AND  |  0_0R  => 

if  OPERAND . OPERATION  /=  S. OPERATION  then 

PRINT  (  " [  "  ) ;  SHOW_SEARCH_CONDITION  (  OPERAND  ) ;  PRINT  (  "  ]  "  ) ; 
else 

SHOW_SEARCH_CONDITION  (  OPERAND  ); 
end  if; 

when  others  =>  SHOW_SEARCH_CONDITION  (  OPERAND  ); 
end  case; 

PRINTLINE;  PRINT  (  P  ); 

OPERAND  :=  OPERAND . ACROSS ; 

case  OPERAND . OPERATION  is  —  again,  must  be  operation 
when  0_AND  |  0_0R  => 

PRINT  (  "I  "  ) ;  SHOW_SEARCH_COND I T I ON  (  OPERAND  ) ;  PRINT  (  "  ]  "  ) ; 
when  others  => 

SHOW_SEARCH_CONDITION  (  OPERAND  ) ; 
end  case; 

end  PARENTHESIZE  RELATIONAL  OPERATORS; 


procedure  SHOW_SEARCH 
begin 

case  S . OPERATION  is 
when  0_EQ  =  > 

when  0_NE  => 

when  0__LT  => 

when  0_GT  => 

when  0__LE  => 

when  0_GE  => 

when  0J3ETWEEN  => 

when  0_IS_IN  => 

when  0_N0T_IN  => 

when  0_LIKE  => 

when  0_AND  => 

when  0  OR  => 


:_CONDITION  (  S  :  in  SQL_OBJECT  )  is 


SHOW_COMPARISON_PREDICATE  (  S . OPERANDS 
SHOW_COMPARISON_PREDICATE  (  S . OPERANDS 
SHOW_COMPARISON_PREDICATE  (  S. OPERANDS 
SHOW_COMPARISON_PREDICATE  (  S . OPERANDS 
SHOW_COMPARISON_PREDICATE  (  S . OPERANDS 
SHOW_COMPARISON_PREDICATE  (  S . OPERANDS 
SHOW_BETWEEN_PREDICATE  (  S . OPERANDS  ) 
SHOW_IN -PREDICATE  (  S. OPERANDS  , 

SHOW_IN_PREDICATE  (  S . OPERANDS  , 

SHOW_LIKE_PREDICATE  (  S . OPERANDS  ) 

P ARENTHES I ZE_RELAT IONAL_OPERATORS  (  S 
PARENTHES I ZE_RELATIONAL_OPERATORS  (  S 


"NOT”  ) ; 
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when  0_N0T  => 

PRINT  (  "NOT  "  ) ; 

case  S. OPERANDS. OPERATION  is  —  must  be  operation 
when  0_AND  |  0_0R  -> 

PRINT  (  "  [  "  )  ; 

SHOW _SEARCH_COND I T I ON  (  S . OPERANDS  ) ; 

PRINT  (  "  ] "  )  ; 
when  others  => 

SHOW_SEARCH_CONDITION  (  S . OPERANDS  ); 
end  case; 

when  others  =>  raise  INTERNAL_ERROR; 
end  case; 

end  SHOW_SEARCH_CONDITION; 
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—  5.19.1  <table  expression? 


procedure  SHOW_TABLE_EXPRESSION  (  S  :  in  SQL_OBJECT  )  is 
CLAUSE  :  SQL_OBJECT  :=  S. ACROSS; 
begin 

PRINT  (  "FROM  "  );  SHOW_SELECT_LIST  (  S  ) ; 

if  CLAUSE. OPERATION  /=  0_NULL_0P  then  —  WHERE  must  have  operation  on  top 
PRINT_LINE;  PRINT  (  "WHERE  "  );  SHOW_SEARCH_CONDITION  (  CLAUSE  ); 
end  if; 

CLAUSE  :=  CLAUSE. ACROSS; 

if  CLAUSE. KIND  /=  OPERATION  or  else  CLAUSE . OPERATION  /=  0_NULL_0P  then 
PRINTLINE;  PRINT  (  "GROUP  BY  "  );  SHOW_SELECT_LIST  (  CLAUSE  ); 
end  if; 

CLAUSE  :=  CLAUSE . ACROSS ; 

if  CLAUSE. OPERATION  /=  0_NULL_0P  then  —  same  as  WHERE 

PRINTLINE;  PRINT  (  "HAVING  "  );  SH0W_SEARCH_C0NDITI0N  (  CLAUSE  ); 
end  if; 

end  SHOW_TABLE_EXPRESSION; 


—  5.25.1  <query  specification? 

procedure  SHOW_QUERY_SPECIFICATION  {  S  :  in  SQL_OBJECT  )  is 
CLAUSE  :  SQL_OBJECT  :=  S. OPERANDS; 
begin 

INDENT  :=  INDENT  +  7;  SET_INDENT  (  INDENT  ) ;  PRINT_LINE ; 
PRINT  (  "SELECT  "  ); 
case  S. OPERATION  is 

when  0_SELEC  =?  null; 

when  0_SELECT_DI ST INCT  =?  PRINT  (  "UNIQUE  "); 
when  others  =?  raise  INTERNAL_ERROR ; 

end  case,- 

SHOW_SELECT_LIST  (  CLAUSE  ) ; 

PRINT_LINE; 

SHOW_TABLE_EXPRESSION  (  CLAUSE . ACROSS  ); 

INDENT  :=  INDENT  -  7; 
if  INDENT  ?=  0  then 
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PRINT  (  "  ; "  )  ;  SET_INDENT  (  INDENT  ) , 
end  if; 

end  SHOW_QUER Y_SPEC I F I CAT I ON ; 


—  5.25.2  <select  list> 


procedure  SHOW_SELECT_LIST  (  S  :  in  SQL_OBJECT  )  is 
begin 

case  S . KIND  is 

when  NAME  |  VALUE  => 

SHOW_VALUE_EXPRESSION  (  S  ) ; 
when  OPERATION  => 
case  S. OPERATION  is 
when  0_STAR  => 

PRINT  (  ) ; 

when  0_AMPERSAND  => 

SHOW_SELECT_LIST  (  S . OPERANDS  ); 

PRINT  (  ",  "  )  ; 

SHOW_SELECT_LIST  (  S . OPERANDS . ACROSS  ); 
when  others  => 

SHOWJVALUEJEXPRESSION  (  S  ) ; 
end  case; 
end  case; 

end  SHOW_SELECT_LIST; 


8.3.5  Corder  by  clause> 


procedure  SHGW_ORDER_BY_CLAUSE  (  S  :  in  SQL_OBJECT  )  is 
begin 

case  S . KIND  is 
when  NAME  => 

PRINT  (  S. NAME. all  ); 
when  OPERATION  => 

case  S. OPERATION  is 
when  0_AMPERSAND  => 

SHOW_ORDER_BY_CLAUSE  (  S . OPERANDS  ) ; 

PRINT  (  ",  "  ) ; 

SHOW_ORDER_BY_CLAUSE  (  S . OPERANDS . ACROSS  ) ; 
when  0_ASC  => 

PRINT  (  S. OPERANDS. NAME. all  ) ; 
when  0_DESC  => 

PRINT  (  S. OPERANDS. NAME. all  S  "  DESC"  ) ; 
when  others  => 

raise  INTERNAL_ERROR ; 
end  case; 
when  others  => 

raise  INTERNAL_ERROR ; 
end  case; 

end  SHOW  ORDER  BY  CLAUSE; 
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—  8.7.3  <insert  value  list) 

procedure  SHOW_INSERT_VALUE_LIST  (  S  :  in  SQL_OBJECT  )  is 
begin 

case  S . KIND  is 
when  VALUE  => 

SHOW_VALUE_SPECIFICATION  (  S  ) ; 
when  OPERATION  => 
case  S. OPERATION  is 
when  0_AND  =  > 

SHOW_INSERT_VALUE_LIST  (  S . OPERANDS  ); 

PRINT  (  ",  "  ); 
when  0_LE  => 
null; 

when  others  => 

raise  INTERNAL_ERROR; 
end  case; 

SHOW_INSERT_VALUE_LIST  (  S . OPERANDS . ACROSS  ); 
when  others  => 

raise  INTERNAL_ERROR ; 
end  case; 

end  SHOW_INSERT_VALUE_LIST; 

—  8.11.2  <set  clause) 

procedure  SHOW_SET_CLAUSES  (  S  :  in  SQL_OBJECT  )  is 
begin 

case  S. OPERATION  is  —  must  be  operation 
when  0_AND  => 

SHOW_SET_CLAUSES  (  S . OPERANDS  );  PRINT  (  ” , "  );  PRINT_LINE ; 
SHOW_SET_CLAUSES  (  S . OPERANDS . ACROSS  ) ; 
when  0_LE  => 

PRINT  (  S . OPERANDS . NAME . all  &  "  =  "  ) ; 

SHOW_VALUE_EXPRES S I ON  (  S . OPERANDS . ACROSS  ); 
when  others  => 

raise  INTERNAL_ERROR ; 
end  case; 

end  SHOW_SET_CLAUSES; 

—  routine  to  show  a  cursor 
procedure  SHOW_CURSOR 

(  CURSOR  :  in  CURSOR_NAME  ;  MESSAGE  :  in  STANDARD . STRING  )  is 

begin 

BLANK_LINE;  SET_INDENT  (  0  );  PRINT  (  MESSAGE  );  PRINTLINE; 

INDENT  :=  -7;  SHOW_QUERY_SPECIFICATION  (  SQL_OBJECT  (  CURSOR . OPERANDS  )  ); 

if  CURSOR. OPERANDS. ACROSS  /=  null  then 
PRINTLINE;  PRINT  (  "ORDER  BY  "); 

SHOW_ORDER_BY_CLAUSE  (  CURSOR . OPERANDS . ACROSS  ) ; 
end  if; 
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PRINT  (  "  /"  );  PRINTLINE; 
exception 

when  others  =>  raise  INTERN AL_ERROR ; 
end  SHOW_CURSOR ; 

—  close  routine 

procedure  CLOSE  (  CURSOR  .  in  out  CURSOR_NAME  )  is 
begin 

SHOW_CURSOR  (  CURSOR  ,  "Cursor  closed  for:”); 
end  CLOSE; 

—  declare  cursor  routines 


procedure  DECLAR 

(  CURSOR  :  in  out  CURSOR_NAME ; 

CURSORJFOR  :  in  SQL_OBJECT; 

0RDERJ3Y  :  in  SQL_OBJECT  :=  NULL_SQL_OBJECT  )  is 

begin 

CURSOR  :  =  new 

SQL_OB JECT_RECORD '  (  OPERATION  ,  null  ,  0_DECLAR  ,  CURSOR_FOR  ); 
CURSOR_FOR . ACROSS  :=  ORDER_BY; 

SHOW_CURSOR  (  CURSOR  ,  "Cursor  declared  for:"  ); 
end  DECLAR; 

—  delete  routines 

procedure  DELETE_FROM 

(  TABLE  :  in  TABLE_NAME; 

WHERE  :  in  SQL_OBJECT  :=  NULL_SQL_OBJECT  )  is 

begin 

BLANK_LINE;  SET_INDENT  (  0  );  PRINT  (  "DELETE  "  &  TABLE . NAME . all  ); 
if  WHERE  /=  null  then 

INDENT  :=  0;  PRINT_LINE;  PRINT  (  "WHERE  "  ); 
SHOW_SEARCH_CONDITION  (  WHERE  ) ; 
end  if; 

PRINT  (  "  /"  );  PRINT_LINE; 
exception 

when  others  =>  raise  INTERNAL_ERROR ; 
end  DELETE_FROM; 

—  fetch  and  into  routines 

procedure  FETCH  (  CURSOR  :  in  out  CURSOR_NAME  )  is 
begin 

SHOW_CURSOR  (  CURSOR  ,  "Fetch  performed  on:"  ); 
end  FETCH; 

procedure  INTEGER_AND_ENUMERATION_INTO  (  VAR  :  out  USFR_TYPE  )  is 
begin 
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PRINT  {  "INTO  with  integer  or  enumeration  argument"  );  PRINT_LINE; 
VAR  :=  USERJTYPE' FIRST;  —  *****  FOR  TEST  PURPOSES 
end  INTEGER_AND_ENUMERATION_INTO; 

procedure  FLOAT_INTO  (  VAR  :  out  USER_TYPE  )  is 
begin 

PRINT  (  "INTO  with  float  argument"  );  PRINT_LINE; 

VAR  :=  USERJTYPE' SMALL;  —  *****  FOR  TEST  PURPOSES 
end  FLOAT_INTO; 

procedure  UNCONSTRAINED_STRING_INTO 

(  VAR  :  out  USER_TYPE  ;  LAST  :  out  INDEX_TYPE  )  is 

begin 

PRINT  (  "INTO  with  unconstrained  string  argument"  );  PRINT_LINE; 
LAST  :=  INDEXJTYPE' FIRST;  —  *****  FOR  TEST  PURPOSES 
end  UNCONSTRAINED_STRING_INTO ; 

procedure  CONSTRAINED_STRING_INTO 

(  VAR  :  out  USER_TYPE  ;  LAST  :  out  INDEXJTYPE  )  is 

begin 

PRINT  (  "INTO  with  constrained  string  argument"  );  PRINT_LINE ; 

LAST  :=  INDEXJTYPE' FIRST;  —  *****  FOR  TEST  PURPOSES 
end  CONSTRAINED_STRING_INTO; 

—  insert  into  routines 

procedure  INSERT_INTO 

(  TABLE  :  in  TABLE_NAME; 

WHAT  :  in  INSERT_ITEM  )  is 

begin 

BLANK_LINE;  SET_INDENT  (  0  );  PRINT  (  "INSERT  INTO  "  ); 
if  TABLE. KIND  =  NAME  then 
PRINT  (  TABLE . NAME . all  ) ; 
else  —  must  be  0_TABLE_C0LUMN_LI ST 
PRINT  (  TABLE. OPERANDS. NAME. all  ); 

PRINT  (  " (  "  ) ; 

SHOW_SELECT_L 1ST  (  TABLE . OPERANDS . ACROSS  ) ; 

PRINT  (  "  )"  ) ; 
end  if; 

PRINT  (  "  :"  );  PRINT_LINE; 

case  WHAT . OPERATION  is  —  must  be  an  operation 
when  0_SELEC  |  0_SELECT_DISTINCT  => 

INDENT  :=  -7;  SHOW_QUERY_SPECIFICATION  (  SQL_OBJECT  (  WHAT  )  ); 

when  0_LE  |  0_AND  => 

PRINT  (  " <  "  ) ; 

SHOW_INSERT_VALUE_LIST  (  SQL_OBJECT  (  WHAT  )  ) ; 

PRINT  (  "  > "  ) ; 
when  others  => 

raise  INTERNAL_ERROR ; 
end  case; 
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PRINT  (  "  /"  );  PRINT_LINE; 
exception 

when  others  =>  raise  INTERNAL_ERROR; 
end  INSERT_INTO; 

function  VALUES  return  INSERT_ITEM  is 
begin 

return  new  SQL_OBJECT_RECORD '  (  OPERATION  ,  null  ,  0_VALUES  ,  null  ); 
end  VALUES; 

—  open  routine 

procedure  OPEN  (  CURSOR  :  in  out  CURSOR_NAME  )  is 
begin 

SHOW_CURSOR  (  CURSOR  ,  "Cursor  opened  for:"); 
end  OPEN; 

—  select  statement  routines 

procedure  SHOW_SELECT  (  S  ;  in  SQL_OBJECT  )  is 
begin 

BLANK_LINE ;  INDENT  :=  -7; 

SHOW_QUERY_SPECIFICATION  (  S  ) ; 

PRINT  (  "  /"  );  PRINTLINE; 
exception 

when  others  =>  raise  INTERNAL_ERROR ; 
end  SHOW_SELECT; 

procedure  SELECT_LIST_SELECT 

(  WHAT  :  in  WHAT_TYPE; 

FROM  :  in  TABLE_LIST; 

WHERE  :  in  SQL_OBJECT  :=  NULL_SQL_OBJECT; 

GROUP_BY  :  in  SQL_OBJECT  :=  NULL_SQL_OB JECT ; 

HAVING  :  in  SQL_OBJECT  :=  NULL_SQL_OBJECT  )  is 

begin 

SHOW_SELECT 
(  BUILD_SELECT 
(  SELECT_TYPE , 

L_CONVERT  (  WHAT  )  ,  FROM  ,  WHERE  ,  GROUP_BY  ,  HAVING  )  ) ; 

end  SELECT_LIST_SELECT ; 

procedure  STAR_SELECT 

(  FROM  :  in  TABLE_LIST ; 

WHERE  :  in  SQL_OBJECT  :=  NULL_SQL_OBJECT ; 

GROUP_BY  :  in  SQL_OBJECT  :=  NULL_SQL_OB JECT ; 

HAVING  :  in  SQL_OBJECT  :=  NULL_SQL_OBJECT  )  is 

begin 

SHOW_SELECT 
(  BUILD_SELECT 
(  SELECT_TYPE , 
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new  SQL_OBJECT_RECORD'  (  OPERATION  ,  null  ,  0_STAR  ,  null  ), 
FROM  ,  WHERE  ,  GROUP_BY  ,  HAVING  )  ); 
end  STAR_SELECT; 

—  update  routines 


procedure  UPDATE 

(  TABLE  :  in  TABLE_NAME; 

SET  :  in  SQL_OB JECT ; 

WHERE  :  in  SCL_OBJECT  ,'JULL_SQL_OB JECT  )  is 

begin 

BLANK_LINE /  SET_INDENT  (  0  );  PRINT  (  "UPDATE  "  &  TABLE . NAME . all  ); 
PRINTLINE;  PRINT  (  "SET  "  );  SET_INDENT  (  4  );  SHOW_SET_CLAUSES  (  SET  ) 
if  WHERE  /=  null  then 

INDENT  :=  0;  SET_INDENT  (  0  );  PRINTLINE;  PRINT  (  "WHERE  "); 
SHOW_SEARCH_CONDIT I ON  (  WHERE  ); 
end  if; 

PRINT  (  "  /"  );  PRINT_LINE ; 
exception 

when  others  =>  raise  INTERNAL_ERROR ; 
end  UPDATE; 

end  ADA_SQL_FUNCTIONS; 


10.  Package  EXAMPLE_DDL 


package  EXAMPLE_TYPES  is 
package  ADA_SQL  is 

type  DEPT_LOC_CHARACTER  is  new  CHARACTER; 
type  DEPT_LOC_INDEX  is  range  1..15; 

type  EMP_JOB_INDEX  is  range  1..11;  —  to  allow  " programmer % " 
type  EMP_NAME_CHARACTER  is  new  CHARACTER; 

type  EMP_NUMBER  is  range  1..10_000; 

type  EMP_NAME  is  array(1..10)  of  EMP_NAME_CHARACTER ; 
type  DEPT_C0DE  is  (  ZERO,  ADMIN,  ESALES,  CSALES,  WSALES,  MKTING, 
RSRCH,  FIN,  COLL  ) ; 

type  EMP_J0B  is  array  (  EMP_JOB_INDEX  range  <>  )  of  CHARACTER; 

type  MONTHLY_PAY  is  digits  6  range  0.0  ..  9999.99; 

type  DEPT_NAME  is  array  (1..15)  of  CHARACTER; 

type  DEPT_LOC  is  array  (  DEPT_LOC_INDEX  range  <>  )  of 

DEPT_LOC_CHARACTER ; 

— type  ANNUAL_PAY  is  digits  7  range  0.0  99999.99; 

type  ANNUAL_PAY  is  digits  6  range  0.0  ..  99999.99; 

— type  TAX_AMQUNT  is  digits  7  range  0.0  99999.99; 
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type  TAX_AM0UNT  is  digits  6  range  0.0  ..  99999.99; 
type  TAX_RATE  is  digits  5  range  0.0  ..  0.5; 

— type  TAX_COMPUTATION_PRECISION  is  digits  10  range  0.0  ..  99999.99999; 
type  TAX_COMPUTATION_PRECISION  is  digits  6  range  0.0  ..  99999.99999; 

— type  TOTAL_PAY  is  digits  9  range  0.0  ..  9999999.99;  —  for  summing  up  $$ 
type  T0TAL_PAY  is  digits  6  range  0.0  ..  9999999.99;  —  for  summing  up  $$ 

subtype  EMP_NUMBER_NOT_NULL_UNIQUE  is  EMP_NUMBER; 
subtype  DEPT_CODE_NOT_NULL_UNIQUE  is  DEPT_C0DE; 

—  Note  the  four  basic  kinds  of  strings  we  have  defined  here: 


+ - + - 

|  components  of  type  |  components  of 

j  derived  from  CHARACTER  j  type  CHARACTER 


unconstrained 

1 

DEPT_L0C 

- +- 

1 

EMP_J0B 

constrained 

1 

EMP_NAME 

1 

DEPT_NAME 

-+- 

- +- 

end  ADA_SQL ; 

end  EXAMPLE_TYPES ; 

With  EXAMPLE_TYPES ; 
package  EXAMPLE_DDL  is 

use  EXAMPLE  TYPES . ADA  SQL; 


package  ADA_SQL  is 

type  EMP  is 
record 
NUMBER 
NAME 
DEPT 
JOB 

MANAGER  : 

SALARY  : 

COMMISSION  : 
end  record; 


EMP_NUMBER_NOT_NULL_UNIQUE ; 
EMP_NAME; 

DEPT_C0DE ; 

EMP_J0B ( 1 . ,10); 

EMP_NUMBER; 

MONTHLY_PAY; 

MONTHLY  PAY; 


—  The  UNIFY  manual  from  which  the  examples  were  taken  (UNIFY  Relational 

Data  Base  Management  System  -  Reference  Manual,  Release  3.2  -  Part 

—  Number  7011)  provides  a  good  example  of  why  strong  typing  is  important: 
they  state  that  the  SALARY  column  contains  monthly  pay  while  the 
COMMISSION  column  contains  annual  commission.  Many  of  the  examples 

—  (like  those  adding  SALARY  and  COMMISSION  )  only  make  sense,  however,  if 
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—  SALARY  and  COMMISSION  are  stated  for  the  same  time  periods .  But  there 

—  are  also  other  examples  where  SALARY  is  multiplied  by  12  before  being 

—  added  to  COMMISSION,  as  if  SALARY  were  monthly  and  COMMISSION  were 

—  yearly.  Had  strong  typing  been  used,  such  errors  would  have  been  more 

—  difficult  to  commit.  In  our  translation  of  the  UNIFY  examples  to 

—  Ada/SQL,  we  have  typed  both  SALARY  and  COMMISSION  as  if  they  were 

—  monthly.  This  avoids  having  to  do  a  lot  of  type  conversions  for  the 

—  example  operations.  (Examples  of  type  conversions  are  still  given, 

—  however,  since  they  are  required  for  other  operations.)  The  UNIFY 

—  examples  are  translated  to  the  corresponding  Ada/SQL,  without  regard  for 

—  whether  or  not  each  operation  really  makes  sense  in  the  larger  context 
of  all  examples . 

type  DEPT  is 
record 

CODE  :  DEPT_CODE_NOT_NULL_UNIQUE; 

NAME  :  DEPT_NAME; 

LOCATION  :  DEPT_LOC ( 1 . . 15 ) ; 
end  record; 

type  TAXES  is 
record 

MIN_AMOUNT  :  ANNUAL_PAY; 

MAX_AMOUNT  :  ANNUAL_PAY; 

BASEJTAX  :  TAX_AMOUNT ; 

MARGINALJRATE  :  TAX_RATE; 

end  record; 

type  CAND  is 
record 

NUMBER  :  EMP_NUMBER_NOT_NULL_UNIQUE; 

NAME  :  EMP_NAME; 

DEPT  :  DEPT_CODE; 

SALARY  :  MONTHLY_PAY; 
end  record; 

end  ADA_SQL ; 

end  EXAMP LE_DDL ; 

with  CURSOR_DEFINITION,  DATABASE,  EXAMPLE_TYPES ; 

use  CURSOR_DEFINITION,  EXAMPLE_TYPES ;  —  vary  the  USE  for  test  purposes 
package  EXAMPLE_VARIABLES  is 

use  ADA_SQL ; 

—  cursors  used 
CURSOR  :  CURSOR_NAME; 
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—  variables  to  obtain  database  values 


V_NUMBER 

V_EMP_NAME 

V_DEPT 

V_JOB 

V_MANAGER 

V_SALARY 

V_MAX_SALARY 

V_COMMISSION 

V_MINIMUM_COMMI S  S 1 ON 

V_DEPT_NAME 

V_LOCAT I ON 

V_MIN_AMOUNT 

V_MAX_AMOUNT 

V_BASE_TAX 

V_EXTRA_TAX 

V_ANNUAL_PAY 

V_MARGINAL_RATE 

V_TOTAL_PAY 

V_MGR_NAME 

V_MGR_SALARY 

V_MGR_LOC AT ION 

COUNT  RESULT 


EMP_NUMBER; 
EMP_NAME ; 
DEPT_CODE ; 
EMP_J0B(1.  .  10)  ; 
EMP_NUMBER; 
MONTHLY_PAY; 
MONTHLY_PAY; 
MONTHLY_PAY; 
MONTHLY_PAY; 
DEPT_NAME ; 
DEPT_L0C ( 1 .  . 15)  , 
ANNUAL_PAY ; 
ANNUAL_P AY ; 
TAX_AMOUNT ; 
TAX_AMOUNT  ; 
ANNUAL_PAY; 
TAX_RATE; 
T0TAL_PAY / 
EMP_NAME; 
MONTHLY_PAY; 
DEPT_LOC ( 1 .  .15)  , 
DATABASE. INTG; 


variable  names  do  not,  of  course, 
have  to  start  with  "v_"  (see 
COUNT_RESULT ,  for  example);  we 
just  use  that  convention  here  to 
ensure  that  they  are  distinct 
from  table  and  column  names 


STR_LAST 
STR_LAST_2 
J0B_LAST 
L0CATI0N_LAST 
LOCATION  LAST  2 


INTEGER; 
INTEGER; 
EMP_JOB_INDEX; 
DEPT_LOC_INDEX; 
DEPT  LOC  INDEX; 


end  EXAMPLE  VARIABLES; 


11.  Package  EXAMPLE_ADA_SQL 


with  ADA_SQL_FUNCTIONS,  DATABASE,  EXAMPLE_TYPES ; 
package  EXAMPLE_ADA_SQL  is 

procedure  INITIATEJTEST  renames  ADA_SQL_FUNCTIONS . INITIATE_TEST , 

—  column  and  table  names 

use  ADA_SQL_FUNCTIONS . CONVERT ; 

package  ADA_SQL  is 

package  BASE_TAX_NAME  is  new 
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’CODE"  ) ; 


’LOCATION" 


ADA_SQL_FUNCTIONS . NAME_PACKAGE  {  "BASE_TAX"  ); 
package  CANDIDATES_NAME  is  new 
ADA_SQL_FUNCTIONS . NAME_PACKAGE  (  "CANDIDATES"  ); 
package  CODE_NAME  is  new  ADA_SQL_FUNCTIONS.NAME_PACKAGE  (  "CODE"  ); 
package  COMMISSION_NAME  is  new 
ADA_SQL_FUNCTIONS . NAME_PACKAGE  {  "COMMISSION"  )  ; 
package  DEPT_NAME  is  new  ADA_SQL_FUNCTIONS . NAME_PACKAGE  (  "DEPT"  ); 
package  EMP_NAME  is  new  ADA_SQL_FUNCTIONS . NAME_PACKAGE  (  "EMP"  ); 
package  JOB_NAME  is  new  ADA_SQL_FUNCTIONS.NAME_PACKAGE  (  "JOB"  ); 
package  LOCATION_NAME  is  new 
ADA_SQL_FUNCTIONS . NAME_PACKAGE  (  "LOCATION"  ); 
package  MARGINAL_RATE_NAME  is  new 
ADA_SQL_FUNCTIONS . NAME_PACKAGE  (  "MARGINAL_RATE"  ); 
package  I-1AX_AM0UNT_NAME  is  new 
ADA_SQL_FUNCTIONS . NAME_PACKAGE  <  " MAX_AMOUNT "  ); 
package  MIN_AMOUNT_NAME  is  new 
ADA_SQL_FUNCTIONS . NAME_PACKAGE  <  " MIN_AMOUNT "  ); 
package  NAM£_NAME  is  new  ADA_SQL_FUNCTIONS . NAME_PACKAGE  (  "NAME"  ); 
package  NUMBER_NAME  is  new  ADA  _SQL_FUNCTIONS . NAME_PACKAGE  (  "NUMBER" 
package  S AL ARY_N AME  is  new  ADA_SQL_FUNCTIONS . NAME_PACKAGE  (  "SALARY" 
package  TAXES_NAME  is  new  ADA_SQL_FUNCTIONS . NAME_PACKAGE  (  "TAXES"  ) 

package  EXAMP  LE__TYPES_INDEX_PACKAGE  is 

subtype  DEPT_NAME_INDEX  is  POSITIVE  range  1  . .  15; 

subtype  EMP_NAME_INDEX  is  INTEGER  range  1  . .  10; 

end  EXAMPLE_TYPES_INDEX_PACKAGE; 

package  DATABASE_TYPE_PACKAGE  is 

type  INTG_TYPE  is  new  ADA_SQL_FUNCTIONS . TYPED_SQL_OB JECT ; 

end  DATABASE  TYPE  PACKAGE; 


package  EXAMPLE_TYPES_TYPE_PACKAGE  is 


ANNUAL_PAY_TYPE  is  new  ADA_SQL_FUNCTIONS . 
DEPT_CODE_TYPE  is  new  ADA_SQL_FUNCTIONS . 
DEPT_LOC_TYPE  is  new  ADA_SQL_FUNCTIONS . 
DEPT_NAME_TYPE  is  new  ADA_SQL_FUNCTIONS . 
EMP_J0B_TYPE  is  new  ADA_SQL_FUNCTIONS . 

EMP_NAME_TYPE  is  new  ADA_SQL_FUNCTIONS , 
EMP_NUMBER_TYPE  is  new  ADA_SQL_FUNCTIONS . 
MONTHLY_PAY_TYPE  is  new  ADA_SQL_FUNCTIONS , 
TAX_AMOUNT_TYPE  is  new  ADA_SQL_FUNCTIONS . 
TAX_COMPUTATION_PRECISION_TYPE  is  new 
_SQL_FUNCTIONS . TYPED_SQL_OB JECT ; 

TAX  RATE  TYPE  is  new  ADA  SQL  FUNCTIONS, 


TYPED, 

TYPED, 

TYPED, 

TYPED, 

TYPED, 

TYPED, 

TYPED, 

TYPED, 

TYPED 


SQL_OBJECT 
SQL_OBJECT 
SQL_OB JECT 
SQL_OBJECT 
SQL_OBJECT 
SQL_OBJECT 
SQL_OB JECT 
SQL_OBJECT 
SQL  OBJECT 


TYPED  SQL  OBJECT; 
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end  EXAMPLE_TYPES_TYPE_PACKAGE ; 

use  EXAMPLE_TYPES_TYPE_PACKAGE; 

package  EXAMPLE_TYPES_NAME_PACKAGE  is 

package  DEPT_TABLE  is 

package  CODE_NAME  is  new 
ADA_SQL_FUNCTIONS . NAME_PACKAGE  (  "DEPT. CODE"  ); 
package  LOCATION_NAME  is  new 
ADA_SQL_FUNCTIONS . NAME_PACKAGE  (  "DEPT . LOCATION"  ); 

function  CODE_FUNCTION  is  new 
CODE_NAME . COLUMN_OR_TABLE_NAME 
(  EXAMP LE_T YP E S_T YP E_P AC K AG E . DEPT_CODE_TYPE  ) ; 
function  LOCATION_FUNCTION  is  new 

LOCATION_NAME . COLUMN_OR_TABLE_NAME  ( ADA_SQL_FUNCTIONS . SQL_OB JECT  ); 
function  LOCAT I ON_F UNCTION  is  new 
LOCATION_NAME . COLUMN_OR_TABLE_NAME 
(  EXAMPLE_TYPES_TYPE_PACKAGE . DEPT_LOC_TYPE  ) ; 

type  TYPED_TABLE_TYPE  is 
record 

CODE  :  EXAMPLE  JTYPES_TYPE_PACKAGE . DEPT__CODE_TYPE ; 

LOCATION  :  EXAMPLE_TYPES_TYPE_PACKAGE.DEPT_LOC_TYPE; 
end  record; 

TYPED_TABLE  : 
constant  TYPED_TABLE_TYPE 
(  CODE  =>  CODE_FUNCTION, 

LOCATION  =>  LOCAT I ON_F UNCTION  ); 

type  UNTYPED_TABLE_TYPE  is 
record 

LOCATION  :  ADA_SQL_F UNCTIONS . SQL_OB JECT ; 
end  record; 

UNTYPED_TABLE  : 

constant  UNTYPED_TABLE_TYPE  := 

(  LOCATION  =>  LOCATION_FUNCTION  ) ; 

end  DEPT_TABLE ; 

package  EMP_TABLE  is 

package  DEPT_NAME  is  new 
ADA_SQL_FUNCTIONS.NAME_PACKAGE  (  "EMP.DEPT"  ); 
package  JOB_NAME  is  new 
ADA_SQL_FUNCTIONS.NAME_PACKAGE  (  "EMP.JOB"  ); 
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package  MANAGER_NAME  is  new 
ADA_SQL_FUNCTIONS.NAME_PACKAGE  (  "EMP .MANAGER"  ); 
package  NAME_NAME  is  new 
ADA_SQL_PUNCTIONS . NAME_PACKAGE  (  "EMP. NAME"  ); 
package  NUMBER_NAME  is  new 
ADA_SQL_FUNCTIONS . NAME_PACKAGE  (  "EMP. NUMBER"  ) ; 
package  SALARY_NAME  is  new 
ADA_SQL_PUNCTIONS.NAME_PACKAGE  (  "EMP. SALARY"  ); 

function  DEPT_FUNCTION  is  new 
DEPT_NAME . COLUMN_OR_TABLE_NAME 
(  EXAMPLE_TYPES_TYPE_PACKAGE . DEPT_CODE_TYPE  ) ; 
function  JOB_FUNCTION  is  new 
JOB_NAME . COLUMN_OR_TABLE_NAME 
(  EXAMPLE_TYPES_TYPE_PACKAGE . EMP_JOB_TYPE  ) ; 
function  MANAGER_FUNCTION  is  new 
MANAGER_NAME . COLUMN_OR_TABLE_NAME 
(  EXAMPLE_TYPES_TYPE_PACKAGE . EMP_NUMBER_TYPE  ) ; 
function  NAME_FUNCTION  is  new 

NAME_NAME . COLUMN_OR_TABLE_NAME  (  ADA_SQL_FUNCTIONS . SQL_OBJECT  ) ; 
function  NUMBER_FUNCTION  is  new 
NUMBER_NAME . COLUMN_OR_TABLE_NAME 
(  EXAMPLE_TYPES_TYPE_PACKAGE . EMP_NUMBER_TYPE  ) ; 
function  SALARY_FUNCTION  is  new 

SALARY_NAME . COLUMN_OR_TABLE_NAME  (  ADA_SQL_FUNCTIONS . SQL_OB JECT  ) ; 
function  S ALARY_FUNCT I ON  is  new 
SALARY_NAME . COLUMN_OR_TABLE_NAME 
(  EXAMPLE_TYPES_TYPE_PACKAGE . MONTHLY_PAY_TYPE  ) ; 

type  TYPED_TABLE_TYPE  is 
record 

DEPT  :  EXAMPLE_TYPES_TYPE_PACKAGE.DEPT_CODE_TYPE; 

JOB  :  EXAMPLE_TYPES_TYPE_PACKAGE . EMP_JOB_TYPE; 

MANAGER  :  EXAMPLE_TYPES_TYPE_PACKAGE . EMP_NUMBER_TYPE ; 

NUMBER  :  EXAMPLE_TYPES_TYPE_PACKAGE . EMP_NUMBER_TYPE; 

SALARY  :  EXAMPLE_TYPES_TYPE_PACKAGE . MONTHLY_PAY_TYPE ; 
end  record; 

TYPED_TABLE  : 

constant  TYPED_TABLE_TYPE  := 

(  DEPT  =>  DEPT_FUNCT I ON , 

JOB  =>  JOB_FUNCTION, 

MANAGER  =>  MANAGER_FUNCTION , 

NUMBER  =>  NUMBER_FUNCT I ON , 

SALARY  =>  SALARY_FUNCTION  ); 

type  UNTYPED_TABLE_TYPE  is 
record 

NAME  ,  SALARY  :  ADA_SQL_FUNCTIONS . SQL_OBJECT ; 
end  record; 
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UNTYPEDJTABLE  : 

constant  UNTYPED_TABLE_TYPE  := 

(  NAME  =>  NAME_FUNCTION, 

SALARY  =>  SALARY_FUNCTION  ) ; 

end  EMPJTABLE; 

end  EXAMPLE_TYPES_NAME_PACKAGE; 
end  ADA_SQL; 

use  ADA_SQL . DATABASE_TYPE_PACKAGE ,  ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE ; 

function  BASE_TAX  is  new 
ADA_SQL . BASE_TAX_NAME . COLUMN_OR_TABLE_NAME 
(  ADA_SQL_FUNCTIONS . SQL_OBJECT  ); 
function  BASE_TAX  is  new 
ADA_SQL . BASE_TAX_NAME . COLUMN_OR_TABLE_NAME 
(  ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . TAX_AMOUNT_TYPE  ) / 
function  CANDIDATES  is  new 
ADA__SQL . CANDIDATES_NAME . COLUMN_OR_TABLE_NAME 
(  ADA_SQL_FUNCTIONS . TABLE_NAME  ) ; 
function  CODE  is  new 

ADA_SQL . CODE_NAME . COLUMN_OR_TABLE_NAME  (  ADA_SQL_F UNCTIONS . SQL_OBJECT  ), 
function  CODE  is  new 
ADA_SQL . CODE_NAME . COLUMN_OR_TABLE_NAME 

(  ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . DEPT_CODE_TYPE  ) ; 
function  COMMISSION  is  new 
ADA_SQL . COMMI S  S ION_NAME . COLUMN_OR_TABLE_NAME 
(  ADA_SQL_FUNCT IONS . SQL_OBJECT  ) ; 
function  COMMISSION  is  new 
ADA_SQL . COMMI SSION_NAME . COLUMN_OR_TABLE_NAME 
(  ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . MONTHLY_PAY_TYPE  ) ; 
function  DEPT  is  new  ADA_SQL . DEPT_NAME . TABLE_NAME_WITH_COLUMN_LIST; 
function  DEPT  is  new 

ADA__SQL . DEPT_NAME . COLUMN_OR_TABLE_NAME  (  ADA_SQL_FUNCTIONS . TABLE_NAME  ) 
function  DEPT  is  new 

ADA__SQL . DEPT_NAME . COLUMN_OR_TABLE_NAME  (  ADA_SQL_FUNCTIONS . TABLE_LIST  ), 
function  DEPT  is  new 

ADAJSQL . DEPT_NAME . COLUMN_OR_TABLE_NAME  {  ADA_SQL_FUNCTIONS . SQL_OBJECT  ), 
function  DEPT  is  new 
ADA_SQL . DEPTJMAME . COLUMN_OR_TABLE_NAME 

(  ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . DEPT_CODE_TYPE  ) ; 
function  DEPT  is  new 
ADA_SQL_FUNCTIONS . CONST ANT_LITERAL 

(  ADA_SQL . EXAMPLE_TYPES_NAME_PACKAGE , DEPT_TABLE . TYPED_TABLE_TYPE , 
ADA_SQL . EXAMPLE_TYPES_NAME_PACKAGE . DEPT_TABLE . TYPEDJTABLE  ) ; 
function  DEPT  is  new 
ADA_SQL_FUNCTIONS . CONSTANT_LITERAL 

(  ADA_SQL . EXAMPLE_TYPES_NAME_PACKAGE . DEPT_TABLE . UNTYPED_TABLE_TYPE , 
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ADA_SQL . EXAMPLEJTYPES_NAME_PACKAGE . DEPTJTABLE . UNTYPED_TABLE  ) ; 
function  EMP  is  new 

ADA_SQL . EMP_NAME . COLUMN_ORJTABLE_NAME  (  ADA_SQL_FUNCTIONS . TABLE_NAME  ) ; 
function  EMP  is  new 

ADA_SQL . EMP_NAME . COL UMN_OR_T AB LE_NAME  (  ADA_SQL_FUNCTIONS . TABLE_LIST  ) ; 
function  EMP  is  new 

ADA_SQI> . EMP_NAME . COLUMN_ORJTABLE_NAME  (  ADA_SQL_F UNCT ION S . SQL_OBJECT  ) ; 
function  EMP  is  new 
ADA_SQL_FUNCTIONS . CONSTANT_LITERAL 

(  ADA_SQL .  EXAMPLE_TYPES_NAME_PACKAGE .  EMPJTABLE .  TYPED_TABLE_IYPE , 

ADA_SQL . EXAMPLEJTYPES_NAME_PACKAGE . EMP  JTABLE . TYPED_TABLE  ) ; 
function  EMP  is  new 
ADA_SQL_FUNCTIONS . CONSTANT_LITERAL 

(  ADA_SQL . EXAMPLEJTYPES_NAME_PACKAGE . EMPJTABLE .  UNTYPED_TABLEJTYPE , 

ADA_SQL . EXAMPLE__TYPES_NAME_PACKAGE . EMP_TABLE . UNTYPED_TABLE  ) ; 
function  JOB  is  new 

ADA_SQL . JOB_NAME . COLUMN_OR_TABLE_NAME  (  ADA_SQL_FUNCTIONS . SQL_OB JECT  )/ 
function  JOB  is  new 
ADA_SQL . JOB_NAME . COLUMN_OR_TABLE_NAME 
(  ADA_SQL . EXAMPLE JTYPES_TYPE_PACKAGE . EMP_JOB_TYPE  ) ; 
function  LOCATION  is  new 
ADA_SQL . LOCAT I ON_NAME . COLUMN_OR_TABLE_NAME 
(  ADA_SQL_FUNCTIONS . SQL_OBJECT  ) ; 
function  LOCATION  is  new 
ADA_SQL . LOCAT I ON_NAM£ . COLUMN_OR_TABLE_NAME 
(  ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . DEPT_LOC_TYPE  ) ; 
function  MARGINAL_RATE  is  new 
ADA_SQL . MARG I N  AL_RAT E_N AME . COLUMN_OR_TABLE_NAME 
(  ADA_SQL_FUNCTION S . SQL_OBJECT  ) ; 
function  MAX_AMOUNT  is  new 
ADA_SQL . MAX_AMOUNT_NAME . COLUMN_OR_TABLE_NAME 
(  ADA_SOL.EXAMPLE_TYPES_TYPE_PACKAGE. ANNUAL_PAY_TYPE  ) ; 
function  MAX_AMOUNT  is  new 
ADA_SQL . MAX_AMOUNT_NAME . COLUMN_OR_TABLE_NAME 
(  AD A_SQL_F UN CT I ON S . SQL_OBJECT  ) ; 
function  MIN_AMOUNT  is  new 
ADA_SQL . MIN_AMOUNT_NAME . COLUMN_OR_TABLE_NAME 
(  ADA_SQL.EXAMPLE_TYPES_TYPE__PACKAGE. ANNUAL_PAY_TYPE  ); 
function  MIN_AMOUNT  is  new 
ADA_SQL . MIN_AMOUNT_NAME . COLUMN_OR_TABLE_NAME 
(  ADA_SQL_FUNCT IONS . SQL_OBJECT  ) ; 
function  NAME  is  new 

ADA_SQL . NAME_NAME . COLUMN_OR_TABLE_NAME  (  ADA_SQL_FUNCTIONS . SQL_OBJECT  ) ; 
function  NAME  is  new 
ADA_SQL  .  NAME_NAME .  COLUMiJ_OR_TABLE_NAME 
(  ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . EMP_NAME_TYPE  ) / 
function  NUMBER  is  new 

ADA_SQL.NUMBER_NAME.COLUMN_OR_TABLE_NAME  (  ADA_SQL_FUNCTIONS . SQL_OBJECT  ) 
function  SALARY  is  new 

ADA_SQL.SALARY_NAME.COLUMN_OR_TABLE_NAME  (  ADA_SQL_FUNCTIONS . SQL_OBJECT  ) 
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function  SALARY  is  new 
ADA_SQL . SALARY_NAME . COLUMN_OR_TABLE_NAME 
(  ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . MONTHLY_PAY_TYPE  ) ; 
function  TAXES  is  new 

ADA_SQL . TAXES_NAME . COLUMN_OR_TABLE_NAKE  (  ADA_SQL_FUNCTIONS . TABLE_NAME  ); 
function  TAXES  is  new 

ADA_SQL . TAXES_NAME . COLUMN_OR_TABLE_NAME  (  ADA_SQL_FUNCTIONS . TABLE_LIST  ); 
function  TAXES  is  new 

ADA_SQL . TAXES_NAME . COLUMN_OR_TABLE_NAME  {  ADA_SQL_FUNCTIONS . SQL_OBJECT  ) ; 
—  correlation  name  packages 
package  DEPT_CORRELATION  is 
generic 

CORRELATION_NAME  :  in  STANDARD . STRING; 
package  NAME  is 

package  ADA_SQL  is 

package  CODE_COLUMN_NAME  is  new 
ADA_SQL_FUNCTIONS.NAME_PACKAGE  (  CORRELATION_NAME  S  ".CODE"  ); 
package  DEPT_TABLE__NAME  is  new 

ADA_SQL_FUNCTIONS.NAME_PACKAGE  (  "DEPT  "  &  CORRELATION_NAME  ); 
package  LOCAT I ON__COLUMN_NAME  is  new 
ADA_SQL_FUNCTIONS . NAME_PACKAGE  (  CORRELATI ON_NAME  &  ".LOCATION"  ); 

end  ADA_SQL; 

function  CODE  is  new 

ADA_SQL . CODE_COLUMN_NAME . COLUMN_OR_TABLE_NAME 

(  EXAMPLE_ADA_SQL . ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . D£FT_CODE_TYPE  ) 
function  DEPT  is  new 

ADA_SQL . DEPT_TABLE_NAME . COLUMN_OR_TABLE_NAME 
(  ADA_SQL_FUNCTIONS . TABLE_NAME  ) ; 
function  LOCATION  is  new 

ADA_SQL . LOCAT ION_COLUMN_NAME . COLUMN_OR_TABLE_NAME 
(  ADA_SQL_FUNCTIONS . SQL_OBJECT  ); 
function  LOCATION  is  new 

ADA_SQL . LOCAT ION_COLUMN_NAME . COLUMN_OR_TABLE_NAME 

(  EXAMPLE_ADA_SQL.ADA_SQL.EXAMPLE_TYPES_TYPE_PACKAGE.DEPT_LOC_TYPE  ) ; 
end  NAME; 

end  DEPT_CORRELATION ; 
package  EMP_CORRELATION  is 
generic 

CORRELATION_NAME  :  in  STANDARD .STRING; 
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package  NAME  is 

package  ADA_SQL  is 

package  D£PT_COLUMN_NAME  is  new 
ADA_SQL_FUNCTIONS.NAME_PACKAGE  (  CORRELATION_NAME  &  ".DEPT"  ); 
package  EMP_TABLE_NAME  is  new 

ADAjSQL_FUNCTIONS.NAME_PACKAGE  (  "EMP  "  &  CORRELATION_NAME  ); 
package  JOB_COLUMN_NAME  is  new 

ADA_SQL_FUNCTIONS.NAME_PACKAGE  (  CORRELAT I ON_NAME  &  ".JOB"  ) ; 
package  NAME_COLUMN_NAME  is  new 
ADA_SQL_FUNCTIONS.NAME_PACKAGE  (  CORRELATION_NAME  &  ".NAME"  ) ; 
package  NUMBER_COLUMN_NAME  is  new 
ADA_SQL_FUNCTIONS.NAME_PACKAGE  (  CORRELAT ION_NAME  &  ".NUMBER"  ) ; 
package  SALARY_COLUMN_NAME  is  new 
ADA_SQL_FUNCTIONS . NAME_PACKAGE  (  CORRELATION_NAME  &  ".SALARY"  ) ; 

end  ADA_SQL ; 

function  DEPT  is  new 

ADA_SQL . DEPT_COLUMN_NAME . COLUMN_OR_TABLE_NAME 

(  EXAMPLE_ADA_SQL . ADA^SQL . EXAMP LE_TYPES_TYPE_PACKAGE . DEPT_CODE_TYPE  ) 
function  EMP  is  new 

ADA_SQL . EMP_TABLE_NAME . COLUMN_OR_TABLE_NAME 

(  ADA_SQL_FUNCTIONS.TABLE_LIST  ); 
function  EMP  is  new 

ADA_0QL . EMP_TABLE_NAME . COLUMN_OR_TABLE_NAME 

(  ADrt_SQL_FUNCTIONS.TABLE_NAME  ); 
function  JOB  is  new 

ADA_SQL . JOB_COLUMN_NAME . COLUMN_OR_TABLE_NAME 

(  EXAMPLE_ADA_SQL . ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . EMP_JOB_TYPE  ) ; 
function  NAME  is  new 

ADA_SQL . NAME_COLUMN_NAME . COLUMN_OR_TABLE_NAME 

(  ADA_SQL_FUNCTIONS . SQL_OBJECT  ) ; 
function  NUMBER  is  new 

ADA_SQL . NUMBER_COLUMN_NAME . COLUMN_OR_TABLE_NAME 

(  EXAMPLE_ADA_SQL . ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . EMP_NUMBER_TYPE 
function  SALARY  is  new 

ADA_SQL . SALARY_COLUMN_NAME . COLUMN_OR_TABLE_NAME 

(  ADA_SQL_FUNCTIONS. SQL_OBJECT  ) ; 
function  SALARY  is  new 

ADA_SC'L . SALARY_COLUMN_NAME . COLUMN_OR_TABLE_NAME 

(  EXAMPLE_ADA_SQL . ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . 

MONTHLY_PAY_TYPE  ) ; 

end  NAME; 

end  EMP_CORRELATION; 

—  conversion  package 


Package  EXAMPLE_ADA_SQL 


EK 


riT.  yv  VVTVTJI M  w  VI'  u_v  '■  .■  -.■  ..■  ..■  ■  ■  ..■  -■■  .f  U»  y  j.»  JJ 


UNCLASSIFIED 


package  CONVERTJTO  is 

package  EXAMP LE_TYPES  is 

function  ANNUAL_PAY  (  L  :  ADA_SQL_FUNCTIONS . SQL_OBJECT  ) 
return  ADA_SQL_FUNCTIONS . SQL_OBJECT  renames  CONVERT_R; 

function  ANNUAL_PAY  (  L  :  ADA_SQL_FUNCTIONS . SQL_OBJECT  ) 
return  ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . ANNUAL_PAY_TYPE 
renames  CONVERT_R ; 

function  TAX_ AMOUNT  (  L  :  ADA_SQL_FUNCTIONS . SQL_OB JECT  ) 
return  ADA_SQL_FUNCTIONS . SQL_OB JECT  renames  CONVERT_R ; 

function  TAX_AMOUNT  (  L  :  ADA_SQL_FUNCTIONS . SQL_OBJECT  ) 
return  ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . TAX_AMOUNT_TYPE 
renames  CONVERT_R; 

function  TAX_COMPUTATION_PRECISION  (  L  :  ADA_SQL_FUNCTIONS . SQL_OBJECT  ) 
return 
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ADA_SQL . EXAMPLE_TYPES  TYPE_PACKAGE . TAX  COMPUTATION  PRECISION  TYPE 


renames  CONVERT_R; 

function  TOTAL_PAY  (  L  :  ADA_SQL_FUNCTIONS . SQL_OBJECT  ) 
return  ADA_SQL_FUNCTI0NS . SQL_OBJECT  renames  CONVERTJR; 

end  EXAMPLE__TYPES  ; 

end  CONVERTJTO; 

—  conversion  functions 

function  CONVERT_COMPONENT_TO_CHARACTER 

(  C  :  EXAMPLE_TYPES . ADA_SQL . DEPT_LOC_CHARACTER  )  return  CHARACTER; 

function  CONVERT_COMPONENT_TO_CHARACTER 

(  C  :  EXAMPLE_TYPES . ADA_SQL . EMP_NAME_CHARACTER  )  return  CHARACTER; 

function  L_CONVERT  is  new 

ADA_SQL_F UNCTIONS . FLOAT_CONVERT  (  EXAMPLE_TYPES . ADA_SQL . ANNUAL_PAY  ) ; 

function  R_CONVERT  (  R  :  EXAMPLE_TYPES . ADA_SQL . ANNUAL_PAY  ) 
return  ADA_SQL_FUNCTIONS . SQL_OBJECT  renames  L_CONVERT ; 

function  L_CONVERT  is  new 
ADA_SQL_FUNCTIONS . INTEGER_AND_ENUMERATION_CONVERT 
(  EXAMPLE_TYPES . ADA_SQL . DEPT_CODE  ) ; 

function  R_CONVERT  (  R  :  EXAMPLE_TYPES . ADA_SQL . DEPT_CODE  ) 
return  ADA_SQL_FUNCTIONS . SQL_OBJECT  renames  L_CONVERT ,■ 
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function  L_CONVERT  is  new 
ADA_SQL_FUNCTIONS . UNCON STRAINED_STRING_CONVERT 
(  EXAMPLEJTYPES. ADA_SQL.DEPT_LOC_INDEX, 

EXAMPLEJTYPES . ADA_SQL . DEPT_LOC_CHARACTER , 

EXAMPLEJTYPES . ADA_SQL . DEPT_LOC  ) ; 

function  R_CONVERT  (  R  :  EXAMPLEJTYPES . ADA_SQL . DEPT_LOC  ) 
return  ADA_SQL_FUNCTIONS . SQL_OBJECT  renames  L_CONVERT ; 

function  L_CONVERT  is  new 

ADA_SQL_FUNCTIONS . CONSTRAINED_CHARACTER_STRING_CONVERT 
(  ADA_SQL . EXAMPLE_TYPES_INDEX_PACKAGE . DEPT_NAME_INDEX , 

EXAMPLE_TYPES . ADA_SQL . DEPT_NAME  ) ; 

function  R_CONVERT  (  R  :  EXAMPLEJTYPES . ADA_SQL . DEPT_NAME  ) 
return  ADA_SQL_FUNCTIONS . SQL_OBJECT  renames  L_CONVERT; 

function  L_CONVERT  is  new 

ADA_SQL_FUNCTIONS. FLOAT  JCONVERT  (  DATABASE . DOUBLE_PRECISION  ) ; 

function  R_CONVERT  (  R  :  DATABASE. DOUBLE_PRECISION  ) 
return  ADA_SQL_FUNCTIONS . SQL_OBJECT  renames  L_CONVERT; 

function  L_CONVERT  is  new 

ADA_SQL_FUNCT I ON S . UNCONSTRAINED_CHARACTER_STRING_CONVERT 
(  EXAMPLEJTYPES. ADA_SQL . EMP_JOB_INDEX  ,  EXAMPLEJTYPES . ADAJ5QL . EMP_JOB  ) ; 

function  RJTONVERT  (  R  :  EXAMPLE_TYPES . ADA_SQL . EMP_JOB  ) 
return  ADA_SQL_FUNCTIONS . SQL_OBJECT  renames  L_CONVERT; 

function  L_CONVERT  is  new 
AD A_SQL_FUNCT I ON S . CONSTRAINED_STRING_CONVERT 
(  ADA_SQL . EXAMPLE JTYPES_INDEX_PACKAGE . EMP_NAME_INDEX , 

EXAMPLE_TYPES . ADA_SQL . EMP_NAME_CHARACTER , 

EXAMPLEJTYPES . ADA_SQL . EMP_NAME  ) ; 

function  R_CONVERT  (  R  :  EXAMPLEJTYPES . ADA_SQL . EMP_NAME  ) 
return  ADA__SQL_FUNCTIONS . SQL_OBJECT  renames  L_CONVERT; 

function  L_CONVERT  is  new 

ADA_SQL_FUNCTIONS . INTEGER_AND_ENUMERATION_CONVERT  (  DATABASE . INTG  ) ; 

function  R_CONVERT  (  R  :  DATABASE . INTG  )  return  ADA_SQL_FUNCT I ON S . SQL_OBJECT 
renames  L_CONVERT; 

function  L_CONVERT  is  new 

ADA_SQL_FUNCTIONS . FLOAT JSONVERT  (  EXAMPLE_TYPES . ADA_SQL . MONTHLY_PAY  ); 

function  R_CONVERT  (  R  :  EXAMPLE_TYPES . ADA_SQL . MONTHLY_PAY  ) 
return  ADA  SQL  FUNCTIONS . SQL  OBJECT  renames  L_CONVERT ; 
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function  CONVERT_CHARACTER_TO_COMPONENT  (  C  :  CHARACTER  )  return  CHARACTER; 

function  CONVERT_CHARACTER_TO_COMPONENT  (  C  :  CHARACTER  ) 
return  EXAMPLE_TYPES . ADA_SQL . DEPT_LOC_CHARACTER ; 

function  CONVERT_CHARACTER_TO_COMPONENT  (  C :  CHARACTER  ) 
return  EXAMPLE_TYPES . ADA_SQL . EMP_NAME_CHARACTER ; 

—  operators 

type  STAR_TYPE  is  (  '  ); 

function  is  new 
ADA_SQL_FUNCT ION S . BINARY_OPERATION 
(  ADA_SQL_FUNCTIONS . 0_AMPERSAND , 

ADA_SQL_FUNCTIONS . SQL_OBJECT, 

AD A_SQL_FUN  CT I ON S . SQL_OBJECT , 

ADA_SQL_FUNCTXONS . SQL_OBJECT  ) ; 

function  is  new 

ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  ADA_SQL_FUNCTIONS.O_AMPERSAND, 

ADA_SQL_FUNCTIONS . TABLE_LIST , 

ADA_SQL_FUNCTIONS . TABLE_NAME , 

ADA_SQL_FUNCTIONS . TABLE_LIST  ) ; 

function  is  new 

ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  ADA_SQL_FUNCTIONS.O_AMPERSAND, 

DATABASE . DOUBLE_PRECISION , 

ADA_SQL_FUNCTIONS . SQL_OBJECT , 

ADA_SQL_FUNCTIONS . SQL_OBJECT  ) ; 

function  "+"  is  new 
ADA_SQL_FUNCTIONS . B I NARY_OPERAT I ON 
(  ADA_SQL_FUNCTIOrS . 0_PLUS , 

ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . ANNUAL_PAY_TYPE , 

EXAMPLEJTYPES . ADA_SQL . ANNUAL_PAY, 

ADA_SQL_FUNCTIONS . SQL__OBJECT  ) ; 

function  "+"  is  new 
ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  ADA_SQL_FUNCTIONS.O_PLUS, 

ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . ANNUAL_PAY_TYPE , 

EXAMPLE_TYPES . ADA_SQL . ANNUAL_PAY, 

ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . ANNUAL_PAY_TYPE  ) ; 

function  "+"  is  new 
ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  ADA_SQL_FUNCTIONS.O  PLUS, 
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ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . MONTHLY_PAY_TYPE , 
ADA_SQL . EXAMPLE_TYPES  JIYPE_PACKAGE . MONTHLY_PAY_T YPE , 
ADA_SQL_FUNCTIONS . SQL_OBJECT  ) ; 

function  "+"  is  new 
ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  ADA_SQL_FUNCT IONS . 0_PLUS , 

ADA_SQL .  EXAMPLE  _TYPES_TYPE_PACKAGE .  MONTHLY_PAY  JIYPE , 
EXAMP LE_T YPE S . ADA_SQL . MONTHLY_PAY , 

ADA_SQL_FUNCTIONS . SQL_OEJECT  ) ; 

function  "+"  is  new 
ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  ADA_SQL_FUNCTIONS . 0_PLUS , 

ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . MONTHLY_PAY_TYPE , 
EXAMP LE_TYPES . ADA_SQL . MONTHLY_PAY , 

ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . MONTHLY_PAY_TYPE  ) ; 

function  "+"  is  new 
ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  ADA_SQL_FUNCTIONS . 0_PLUS , 

ADA_SQL . EXAMPLE  JTYPES_TYPE_PACKAGE. MONTHLY_PAY_TYPE , 
ADA_SQL . EXAMPLEJTYPES _TYPE_PACKAGE . MONTHLY_PAY_TYPE , 
ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . MONTHLY_PAY_TYPE  ) ; 

function  "+"  is  new 
ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  ADA_SQL_F UNCT IONS . 0_PLUS , 

ADA_SQL . EXAMPLEJTYPES  JTYPE_PACKAGE . TAX_AMOUNT  JIYPE , 
ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . TAX_AMOUNT  JIYPE , 
ADA_SQL_FUNCTIONS . SQLJDBJECI  ) ; 

function  is  new 

ADA_SQL_FUNi_ T ION S  .  BINARY_OPERATION 
(  ADA_SQL_FUNCTIONS.O_MINUS, 

ADA_SQL . EXAMPLE  JIYPESJIYPE_PACKAGE . ANNUAL_PAY_TYPE , 
ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . ANNUAL_PAYJIYPE , 
ADA_SQL_FUNCTIONS . SQL_OBJECT  ) ; 

function  is  new 

ADA_SQL_FUNCT IONS . BINARY_OPERATION 
(  ADA_SQL_FUNCT I ONS . 0_MINUS , 

EXAMPLEJTYPES . ADA_SQL . ANNUAL_PAY , 

ADA_SQL . EXAMPLEJTYPESJTYPE_PACKAGE . ANNUAL_P A Y_T YP  E , 
ADA_SQL_FUNCTIONS . SQL_OBJECT  ) ; 

function  is  new 

ADA_SQL_FUNCT ION  S . BINARY_OPERATION 
(  ADA_SQL_FUNCTIONS.OJIIMES, 

ADA_SQL . EXAMPLE  JTYPESJTYPE_PACK AGE . ANNUAL_PAY  JTYPE , 
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EXAMP LE_TYPES . ADA_SQL . ANNUAL_PAY , 

ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . ANNUAL_PAY_TYPE  ) ; 


function  " is  new 
ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  ADA_SQL_FUNCTIONS.O_TIMES, 

ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . MONTHLY_PAY_TYPE , 
EXAMP IiE_TYPES  .  ADA_SQL .  MONTHLY_PAY, 

ADA_SQL . EXAMPLE_TYPES_TYPE_P ACKAGE . MONTHLY_PAY_TYPE  ) ; 


function  is  new 
ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  ADA_SQL_FUNCTIONS . 0_TIM£S , 

EXAMPLE_TYPES . ADA_SQL . MONTHLY_PAY , 

ADA_SQL . EXAMPLE_TYPESJTYPE_P ACKAGE . MONTHLY_PAY_TYPE , 
ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . MONTHLY_PAY_TYPE  ) ; 


function  is  new 

ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  ADA_SQL_FUNCT IONS . OJTIMES , 

ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . MONTHLY_PAY_TYPE , 
ADA_SQL . EXAMPLE_TYPES_TYPE_P ACKAGE . MONTHLY_PAY_TYPE , 
ADA_SQL . EXAMPLE_TYPES_TYPE_P ACKAGE . MONTHLY_PAY_TYPE  ) ; 


function  is  new 

ADA_SQL_FUNCTI ON  S . BINARY_OPERATION 
(  ADA_SQL_FUNCTIONS . 0_TIMES, 

ADA_SQL . EXAMP LE_TYPES_TYPE_P ACKAGE . MONTHLY_PAY_TYPE , 
EXAMPLE_TYPES . ADA_SQL . MONTHLY_PAY, 

ADA_SQL_FUNCTIONS . SQLJDBJECT  ) ; 


function  is  new 

ADA_SQL_FUNCT IONS . B I NARY_OP  ERAT ION 
(  ADA_SQIi_FUNCTIONS  .  0_TIMES , 

ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . TAX_COMPUTATION_PRECISION_TYPE 
ADA_SQL . EXAMPLE_TYPES_TYPE_P ACKAGE . TAX_COMPUTATION_PRECISION_TYPE 
ADA_SQL_FUNCTIONS . SQL_OBJECT  ) ; 

function  ">"  is  new 
ADA_SQL_FUNCTIONS . BINARY_OPERATICN 
(  ADA_SQL_FUNCTIONS.O_GT, 

ADA_SQL . DATABASE_TYPE_P ACKAGE . INTG_TYPE, 

DATABASE. INTG, 

ADA_SQL_FUNCTIONS . SQL_OBJECT  ) ; 

function  ">"  is  new 
ADA_SQL_FUNCT IONS . BINARY_OPERATION 
(  ADA_SQL_FUNCTIONS.O_GT, 

ADA_SQL . EXAMPLE_TYPES_TYPE_P ACKAGE . MONTHLY_PAY_TYPE , 

ADA_SQL . EXAMP LE_TYPES_TYPE_P ACKAGE . MONTHLY_PAY_TYPE , 
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ADA_SQL_FUNCTIONS . SQL_OBJECT  ) ; 

function  ">"  is  new 
ADA_SQL_F UNCTIONS . BINARY_OPERATION 
(  ADA_SQL_FUNCTIONS . 0_GT , 

ADA_SQL . EXAMP LE_T YP E S_T YP  E_PACKAGE . MONTHLY_PAY_TYPE , 
EXAMP LE_TYPES . ADA_SQL . MONTHLY_PAY , 

ADA_SQL_FUNCTIONS . SQL_OBJECT  ) ; 

function  ">*"  is  new 
ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  ADA_SQL_FUNCTIONS . 0_GE , 

ADA_SQL . DATABASE_TYPE_PACKAGE . INTG_TYPE , 

DATABASE. INTG, 

ADA_SQL_F  UNCT I ON S . SQL_OB JECT  ) ; 

function  ">="  is  new 
ADA_SQL_FUNCT I ON S . BINARY_OPERATION 
(  ADA_SQL_FUNCTIONS . 0_GE , 

ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . MONTHLY_PAY_TYPE , 
EXAMPLE_TYPES . ADA_SQL . MONTHLY_PAY , 

ADA_SQL_FUNCTIONS . SQL_OBJECT  ) / 

function  ">="  is  new 
ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  ADA_SQL_FUNCTIONS . 0_GE , 

ADA_SQL . EXAMPLE_TYPES_TYPE_P ACKAGE . MONTHLY_PAY_TYPE , 
ADA_SQL . EXAMPLE_TYPES_TYPE_P ACKAGE . MONTHLY_PAY_TYPE , 
ADA_SQL_FUNCTIONS . SQL_OBJECT  ) ; 

function  "<"  is  new 
ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  ADA_SQL_FUNCTIONS . 0_LT , 

ADA_SQL . EXAMPLE_TYP  ES_TYP  E_P ACKAGE . MONTHLY_PAY_TYPE , 
ADA_SQL . EXAMP LE_TYPES_TYPE_P ACKAGE . MONTH LY_P A Y_T YP E , 
ADA_SQL_FUNCTIONS . SQL_OBJECT  ) ; 

function  "<  =  "  is  new 
ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  ADA_SQL_FUNCTIONS . 0_LE , 

ADA_SQL . EXAMP LE_TYPES_TYPE_P ACKAGE . DEPT_CODE_TYPE , 
EXAMPLE_TYPES . ADA_SQL . DEPT_CODE, 

ADA_SQL_FUNCTIONS . SQL_OBJECT  ) ; 

function  "<="  is  new 
ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  ADA_SQL_FUNCTIONS . 0_LE , 

ADA_SQL_FUNCTIONS . INSERT_ITEM, 

EXAMPLE_TYPES . ADA_SQL . DEPT_CODE , 

ADA_SQL_FUNCTIONS . INSERT_ITEM  ) ; 
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function  "<="  is  new 
ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  ADA_SQL_FUNCT IONS . 0_LE , 

ADA_SQL . EXAMP LE_TYPES_TYPE_P ACKAGE . MONTH L Y_PA Y_TYPE , 
EXAMPLE_TYPES . ADA_SQL . MONTHLY_PAY, 

ADA_SQL_FUNCT IONS . SQL_OB JECT  ) ; 

function  "<="  is  new 
ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  ADA_SQL_FUNCTIONS . 0_LE , 

ADA_SQL . EXAMPLE_TYPES_TYPE_P ACKAGE . MONTHLY_PAY_TYPE , 
ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . MONTHLY_PAY_TYPE , 
ADA_SQL_FUNCT I ON S . SQL_OBJECT  ) ; 

function  "and"  is  new 
ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  ADA_SQL_FUNCT IONS . 0_AND , 

ADA_SQL . EXAMPLE_TYPES_TYPE_P ACKAGE . ANNUAL_PAY_TYPE , 
ADA_SQL . EXAMPLE_TYPES_TYPE_P ACKAGE . ANNUAL_PAY_TYPE , 
ADA_SQL . EXAMPLE_TYPES_TYPE_P ACKAGE . ANNUAL_PAY_TYPE  ) ; 

function  "and"  is  new 
ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  ADA_SQL_FUNCT I ON S . 0_AND , 

ADA_SQL_FUNCTIONS . INSERT_ITEM, 

EXAMPLE_TYPES . ADA_SQL . DEPT_LOC , 

ADA_SQL_FUNCTIONS . INSERT_ITEM  ) ; 

function  "and"  is  new 
ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  ADA_SQL_FUNCTIONS.O_AND, 

ADA_SQL_FUNCT IONS . INSERT_ITEM, 

EXAMPLE_TYPES . ADA_SQL . DEPT_NAME , 

ADA_SQL_FUNCTIONS . INSERT_ITEM  ) ; 

function  "and"  is  new 
ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  ADA_SQL_FUNCTIONS.O_AND, 

EXAMPLE_TYPES . ADA_SQL . MONTHLY_P AY , 

EXAMPLE_TYPES . ADA_SQL . MONTHLY_PAY, 

ADA_SQL . EXAMPLE_TYPES_TYPE_P ACKAGE . MONTHLY_PAY_TYPE  ) ; 

function  "and"  is  new 
ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  ADA_SQL_FUNCTIONS . 0_AND , 

ADA_SQL_FUNCTIONS . SQL_OBJECT, 

ADA_SQL_FUNCTIONS . SQL_OBJECT, 

ADA_SQL_FUNCTIONS . SQL_OBJECT  ) ; 

function  ASC  is  new 
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ADA_SQL_FUNCTIONS . UNARY_OPERATION 
(  ADA_SQL_FUNCT ION S . 0_ASC , 

ADA_SQL_FUNCTIONS . SQL_OBJECT, 

ADA_SQL_FUNCTIONS . SQL_OBJECT  ) ; 

function  AVG  is  new 
ADA_SQL_FUNCT ION S . UNARY_OPERAT ION 
(  ADA_SQL_FUNCT IONS . 0_AVG , 

ADA_SQL_FUNCT ION S . SQL_OB JECT , 

ADA_SQL_F13NC'JI0NS  .  SQL_OBJECT  )  ; 

function  AVG  is  new 
ADA_SQL_FUNCTIONS . UNARY_OPERATION 
(  ADA_SQL_FUNCT IONS . 0_AVG , 

ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . MONTHLY_PAY_TYPE , 

ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . MONTHLY_PAY_TYPE  ) ; 

function  BETWEEN  is  new 
ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  ADA_SQL_FUNCTIONS . 0_BETWEEN , 

ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . ANNUAL_PAY_TYPE , 

ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . ANNUAL_PAY_TYPE , 

ADA_SQL_FUNCTIONS . SQL_OBJECT  ) ; 

function  BETWEEN  is  new 
AD A_S  QL_F  UNCT IONS . BINARY_OPERATION 
(  ADA_SQL_FUNCTIONS . 0_BETWEEN , 

EXAMPLEJIYPES . ADA_SQL . ANNUAL_PAY, 

ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . ANNUAL_PAY__TYPE , 

ADA_SQL_FUNCTIONS . SQL_OBJECT  ) ; 

function  BETWEEN  is  new 
ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  ADA_SQL_FUNCTIONS.O_BETWEEN, 

ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . MONTHLY_PAY_TYPE , 

ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . MONTHLY_PAY_TYPE , 

ADA_SQL_FUNCT IONS . SQL_OBJECT  ) ; 

function  COUNT  (  STAR  :  STAR_TYPE  )  return  ADA_SQL_FUNCTIONS . SQL_OBJECT; 

function  COUNT  (  STAR  ;  STAR_TYPE  ) 
return  ADA_SQL . DATABASE_TYPE_PACKAGE . INTG_TYPE; 

function  DESC  is  new 
ADA_SQL_FUNCT ION S . UNARY_OPERATION 
(  ADA_SQL_F UNCT IONS . 0_DESC , 

ADA_SQL_FUNCTIONS . SQL_OBJECT , 

ADA_SQL_FUNCTIONS . SQL_OBJECT  ) ; 

function  EQ  is  new 
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ADA_SQL_FUNCT IONS . BINARY_OPERATION 
(  ADA_SQL_FUNCT IONS . 0_EQ , 

ADA_SQL. EXAMPLE_TYPES_TYPE_PACKAGE . DEPT_CODE_TYPE , 
EXAMP LE_TYPES . ADA_SQL . DEPT_CODE , 

ADA_SQL_FUNCTIONS . SQL_OBJECT  ) ; 

function  EQ  is  new 
ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  ADA_SQL_FUNCTIONS . 0_EQ , 

ADA_SQL . EXAMPLE_T YP E S_T YP E_P ACKAG E . DEPT_CODE_TYPE , 
ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . DEPT_CODE_TYPE , 
ADA_SQL_FUNCTIONS . SQL_OBJECT  ) ; 


function  EQ  is  new 
ADA_SQL_FUNCT ION S . BINARY_OPERATION 
(  ADA_.SQL_FUNCTI0NS.0_EQ, 

ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . EMP_JOB_TYPE , 
ADA_SQL . EXAMP LE_TYPES_TYPE_PACKAGE . EMP_JOB_TYPE , 
ADA_SQL_FUNCT ION S . SQL_OBJECT  ) ; 

function  EQ  is  new 
ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  ADA_SQL_FUNCT I ON S . 0_EQ , 

ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . EMP_NUMBER_TYPE , 
ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . EMP_NUMBER_TYPE , 
ADA_SQL_FUNCTI0NS . SQL_OBJECT  ) ; 

function  EQ  is  new 
ADA_SQL_FUNCT IONS . B INARY_OPERAT ION 
(  ADA_SQL_FUNCT IONS . 0_EQ , 

ADA_SQL. EXAMP LE_TYPES_TYPE_PACKAGE . MONTHLY_PAY_TYPE, 
ADA_SQL . EXAMP LE_TYPES_TYPE_PACKAGE . M0NTHLY_P AY_TYPE , 
ADA_SQL_FUNCTIONS . SQL_OBJECT  ) ; 


function  INDICATOR  is  new 
ADA_SQL_FUNCTIONS . INDICATOR_FUNCTION 
(  EXAMPLE_TYPES . ADA_SQL . ANNUAL_PAY , 

ADA_SQL . EXAMP LE_TYPES_TYPE_PACKAGE . ANNUAL_PAY_TYPE  ) ; 


function  IS_IN  is  new 
ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  ADA_SQL_FUNCTIONS . 0_IS_IN , 

ADA_SQL. EXAMPLE_TYPES_TYPE_PACKAGE . DEPT_CODE_TYF  E , 
ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . DEPT_CODE_TYPE, 
ADA_SQL_FUNCTIONS . SQL_OBJECT  ) ; 


function  IS_IN  is  new 
ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  ADA_SQL_F UNCTIONS . 0_IS_IN, 

ADA_SQL. EXAMPLE  TYPES  TYPE  PACKAGE . EMP  J0B_TYPE, 
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ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . EMP_JOB_TYPE, 
ADA_SQL_FUNCTIONS . SQL_OBJECT  ) ; 

function  LIKE  is  new 
ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  ADA_SQL_FUNCTIONS . 0_LIKE , 

ADA_SQL . EXAMPLE_TYPESJTYPE_PACKAGE . DEPT_LOC_TYPE , 
EXAMPLE_TYPES . ADA_SQL . DEPT_LOC , 

ADA_SQL_FUNCT IONS . SQL_OBJECT  ) ; 


function  LIKE  is  new 
AD A_S  QL_FUNCT I ON S . BINARY_OPERATION 
(  ADA_SQL_FUNCT IONS . 0_LIKE , 

ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . EMP_JOB_TYPE , 
EXAMPLE_TYPES . ADA_SQL . EMP_JOB , 

ADA_SQL_FUNCTIONS . SQL_OB JECT  ) ; 

function  LIKE  is  new 
ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  ADA_SQL_FUNCTIONS.O_LIKE, 

ADAJ3QL . EXAMPLE_TYPES_TYPE_PACKAGE . EMP_NAME_TYPE , 
EXAMPLE_TYPES . ADA_SQL . EMP_NAME, 

ADA_SQL_FUNCTIONS . SQL_OBJECT  ) ; 

function  MAX  is  new 
AD A_SQL_FUNCT I ON S . UNARY_OPERATION 
(  ADA_SQL_FUNCTIONS.O_MAX, 

ADA_SQL_FUNCT I ON S . SQL_OBJECT, 

ADA_SQL_FUNCTIONS . SQL_OBJECT  ) ; 


function  MAX  is  new 
AD A_SQL_F  UNCTIONS . UNARY_OPERATION 
(  ADA_SQL_FUNCTIONS . 0_MAX , 

ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . MONTHLY_PAY_TYPE , 
ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . MONTHLY_PAY_TYPE  ) ; 

function  MIN  is  new 
ADA_SQL_FUNCTIONS . UNARY_OPERATION 
(  ADA_SQL_FUNCTIONS.O_MIN, 

ADA_SQL_FUNCTIONS . SQL_OBJECT, 

ADA_SQL_FUNCTIONS . SQL_OB JECT  ) ; 

function  NE  is  new 
ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  ADA_SQL_FUNCTIONS.O_NE, 

ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . DEPT_LOC_TYPE , 

AD^_  SQL . EXAMPLE_TYPES_TYPE_PACKAGE . DEPT_LOC_TYPE , 
ADA_SQL_FUNCT IONS. SQL_OB JECT  ); 

function  NE  is  new 
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ADA_SQL_FUNCT ION S . BINARY_OPERATION 
(  ADA_SQL_FUNCTIONS . 0_NE , 

ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . EMP_NAME_TYPE , 
ADA_SQL. EXAMPLE  JTYPES_TYPE_PACKAGE . EMP_NAME_TYPE, 
ADA_SQL_FUNCTIONS . SQL_OBJECT  ) ; 


function  NE  is  new 
ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  ADA_SQL_FUNCTIONS . 0_NE , 

ADA_SQL . EXAMPLE__TYPES_TYPE_PACKAGE  EMP_NUMBER_TYPE , 
ADA_SQL . EXAMPLE_TYP E S_T YP E_P ACK AG E . EMP_NUMBER_TYPE , 
ADA_SQL_FUNCTIONS . SQL_OBJECT  ) ; 

function  "not"  is  new 
ADA_SQL_FUNCT ION S . UNARY_OPERATION 
(  ADA_SQL_FUNCTIONS . OJNOT , 

ADA_SQL_FUNCTIONS . SQL_08 JECT , 

AD A_SQL_FUNCT I ON S . SQL_OBJECT  ) ; 

function  "or"  is  new 
ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  ADA_SQL_FUNCTIONS . 0_0R , 

ADA_SQL_FUNCTIONS . SQL_OBJECT, 

ADA_SQL_FUNCTIONS . SQL_OBJECT, 

ADA_SQL_FUNCTIONS . SQL_OBJECT  ) ; 

function  "or"  is  new 
ADA_SQL_FUNCT ION  S . BINARY_OPERATION 
(  ADA_SQL_FUNCT ION S . 0_0R , 

EXAMPLE_TYPES . ADA_SQL . DEPT_CODE, 

EX AMP  L  E_T  YP  E  S . ADA_SQL . DEPT_C0DE , 

ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . DEPT_CODE_TYPE  ) 

function  "or"  is  new 
ADA_SQL_FUNCTIONS . BINARY_OPERATION 
(  ADA_SQL_FUNCTIONS.O_OR, 

ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . UEPT_CODE_TYPE , 
EXAMPLE_TYPES , ADA_SQL . DEPT_CODE , 

ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . DEPT_CODE_TYPE  ) 

function  SUM  is  new 
ADA_SQL_FUNCTIONS . UNARY_OPERATION 
(  ADA_SQL_FUNCTIONS.O_SUM, 

AD A_SQL_F  UNCTIONS . SQL_OBJECT , 

ADA_SQL_FUNCTIONS . SQL_OB JECT  ) / 


function  SUM  is  new 
ADA_SQL_FUNCTIONS . UNARY_OPERATION 
(  ADA_SOL_FUNCTIONS . 0_SUM, 

ADA_SQL . EXAMPLE  TYPES  TYPE_PACKAGE . MONTHLY  PAY  TYPE 
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ADA_SQL . EXAMPLE _TYPES_TYPE_PACKAGE . MONTHLY_PAY_TYPE  ) ; 

—  SQL  functions 

procedure  CLOSE  (  CURSOR  :  in  out  ADA_SQL_FUNCTXONS . CURSOR_NAME  ) 
renames  ADA_SQL_FUNCTIONS . CLOSE; 

procedure  DECLAR 

(  CURSOR  :  in  out  ADA_SQL_FUNCTIONS . CURSOR_NAME; 

CURSOR_FOR  :  in  ADA_SQL_FUNCTIONS . SQL_OBJECT; 

ORDER_BY  :  in  ADA_SQL_FUNCTIONS . SQL_OBJECT  : = 

ADA_S  QL_F  UNCTIONS . NULL_SQL_OBJECT  ) 
renames  ADA_SQL_FUNCT IONS . DECLAR; 

procedure  DELETE_FROM 

(  TABLE  :  in  ADA_SQL_FUNCTIONS . TABLE_NAME; 

WHERE  :  in  ADA_SQL_FUNCTIONS . SQL_OBJECT  := 

ADA_SQL_FUNCTIONS . NULL_SQL_OBJECT  ) 
renames  ADA_S QL_F UNCT I ON S . DELETE_FROM ; 

procedure  FETCH  (  CURSOR  :  in  out  AD*_SQL_FUNCTIONS . CURSOR_NAME  ) 
renames  ADA_SQL_FUNCTIONS . FETCH; 

procedure  INTO  is  new 

ADA_SQL_FUNCTIONS . FLOAT_INTO  (  EXAMPLE_TYPES . ADA_SQL . ANNUAL_PAY  ); 
procedure  INTO  is  new 

ADA_SQL_FUNCT ION  S . INTEGER_AND_ENUMERATION_INTO 
(  EXAMPLE_TYPES . ADA_SQL . DEPT_CODE  ) ; 

procedure  INTO  is  new 

ADA_SQL_FUNCTIONS . UNCONSTRAINED_STRING_INTO 
(  EXAMPLE_TYPES . ADA_SQL . DEPT_LOC_INDEX, 

EXAMPLE_TYPES . ADA_SQL . DEPT_LOC_CHARACTER , 

EXAMP LE_T YP E S . ADA_SQL . DEPT_LOC  ) ; 

procedure  INTO  is  new 
ADA_SQL_FUNCTIONS . CONSTRAINED_STRING_INTO 
(  ADA_SQL  .  EXAMPLE_TYPES_INDEX_PACKAGE  .  DEPT_NAME_INDEX , 

CHARACTER , 

EXAMPLE_TYPES  ADA_SQL . DEPT_NAME  ) ; 
procedure  INTO  is  new 

ADA_SQL_FUNCTIONS . UNCONSTRAINED_STRING_INTO 
(  EXAMPLE_TYPES . ADA_SQL . EMP_JOB_INDEX , 

CHARACTER, 

EXAMPLE_TYPES . ADA_SQL . EMP_JOB  ) ; 

procedure  INTO  is  new 
ADA_SQL_FUNCTIONS . CONSTRAINED_STRING_INTO 
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(  ADA_SQL . EXAMP LE_TYPES_INDEX_PACKAGE . EMP_NAME_INDEX , 

EXAMP LE_TYPES . ADA_SQL . EMP_NAME_CHARACTER , 

EXAMPLE_TYPES . ADA_SQL . EMP_NAME  ) ; 

procedure  INTO  is  new 

AD A_SQL_FUNCT IONS . INTEGER_AND_ENUMERATION_INTO 
(  EXAMPLE_TYPES . ADA_SQL . EMP_NUMBER  ) ; 

procedure  INTO  is  new 

ADA_SQL_FUNCTIONS  .  INTEGER_AND_E2'jUMERATI0N_INT0  (  DATABASE  .  INVG  )  ; 
procedure  INTO  is  new 

ADA_SQL_FUNCTIONS . FLOAT_INTO  (  EXAMPLE_TYPES . ADA_SQL . MONTHLY_PAY  ) 
procedure  INTO  is  new 

ADA_SQL_FUNCTIONS . FLOAT_INTO  (  EXAMPLEJTYPES . ADA_SQL . TAX_AMOUNT  ); 
procedure  INTO  is  new 

ADA_SQL  FUNCTIONS . FLOAT_INTO  (  EXAMP LE_TYPES . ADA_SQL . TAX_RATE  ) ; 
procedure  INTO  is  new 

ADA_SQL_FUNCTIONS . FLOAT_INTO  (  EXAMPLE_TYPES . ADA_SQL . TOTAL_PAY  ) ; 

procedure  INSERT_INTO 

(  TABLE  :  in  ADA_SQL_FUNCTIONS . TABLE_NAME; 

WHAT  :  in  ADA_SQL_FUNCTIONS . INSERT_ITEM  ) 
renames  ADA_SQL_FUNCTIONS . INSERT_INTO ; 

function  VALUES  return  ADA_SQL_FUNCTIONS . INSERT_ITEM 
renames  ADA_SQL_FUNCTIONS . VALUES ; 

procedure  OPEN  (  CURSOR  :  in  out  ADA_SQL_FUNCTIONS . CURSOR_NAME  ) 
renames  ADA_SOL_FUNCT IONS . OPEN; 

function  SELEC  is  new 
ADA_SQL_FUNCTIONS . SELECT_LIST_SUBQUERY 
(  ADA_SQL_FUNCTIONS . 0_SELEC , 

AD A_SQL_FUN  CT I ON  S . SQL_OBJECT , 

ADA_SQL_FUNCTIONS . INSERT_ITEM  ) ; 

function  SELEC  is  new 
ADA_SQL_FUNCTIONS . SELECT_LI ST_SUBQUERY 
(  ADA_SQL_FUNCTIONS . 0_SELEC , 

ADA_SQL_FUNCTIONS . SQL_OBJECT, 

ADA_SQL_FUNCTIONS . SQL_OBJECT  ) ; 


function  SELEC  is  new 
ADA_SQL_FUNCTIONS . SELECT_LIST_SUBQUERY 
(  ADA_SQL_FUNCTIONS . 0_SELEC , 

ADA_SQL . EXAMPLE_TYPES_TYPE_P ACKAGE . DEPT_CODE_TYPE , 
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ADA_SQL .  EXAMPLE_TYPES_TYPE_PACKAGE .  DEPT_CODE_TYPE  )  ; 

function  SELEC  is  new 
ADA_SQL_FUNCT ION S . SELECT_LIST_SUBQUERY 
(  ADA_SQL_FUNCTIONS . 0_SELEC , 

ADA_SQL . EXAMP LE_TYPES_TYPE_PACKAGE . EMP_JOB_TYPE , 

ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . EMP_JOB_TYPE  ) ; 

function  SELEC  is  new 
ADA_SQL_FUNCT ION S . 5ELECT_LI£T_SUBQUERY 
(  ADA_SQL ^FUNCTIONS  .  0_SELEC , 

ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . EMP_NAME_TYPE , 
ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . EMP_NAME_TYPE  ) ; 

function  SELEC  is  new 
ADA_SQL_FUNCTIONS . SELECT_LIST_SUBQUERY 
(  ADA_SQL_FUNCTIONS.O_SELEC, 

ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . MONTHLY_PAY_TYPE , 
ADA_SQL . EXAMPLE_TYPES_TYPE_PACKAGE . MONTHLY_PAY_TYPE  ) ; 

function  SELEC 

(  WHAT  :  STARJTYPE; 

FROM  :  ADA_SQL_FUNCTIONS.TABLE_LIST; 

WHERE  :  ADA_SQL_FUNCTIONS . SQL_OB JECT  : * 

ADA_SQL_FUNCTIONS . NULL_SQL_OB JECT ; 

GROUP_BY  :  ADA_SQL_FUNCTIONS . SQL_OBJECT  := 

ADA_SQL_FUNCTIONS . NULL_SQL_OBJECT ; 

HAVING  :  ADA_SQL_FUNCTIONS . SQL_OB JECT  := 

ADA_SQL_FUNCTIONS . NULL_SQL_OBJECT  ) 
return  ADA_SQL_FUNCT I ON S . SQL_OBJECT; 

procedure  SELEC  is  new 
ADA_SQL_FUNCTIONS . SELECT_LI ST_SELECT 
(  ADA_SQL_FUNCTIONS . 0_SELEC , 

ADA_SQL_FUNCTIONS . SQL_OBJECT  )  ; 

function  SELECT_OISTINCT  is  new 
ADA_SQL_FUNCTIONS  .  SELECT_LI ST_SUBQUEP.Y 
(  ADA_SQL_FUNCTIONS . 0_SELECT_DISTINCT , 

ADA_SQL_FUNCTIONS . SQL_OBJECT, 

ADA_SQL_FUNCTIONS . SQL_OBJECT  ); 


procedure  UPDATE  (  TABLE  :  in  ADA_SQL ^FUNCTIONS . TABLE_NAME ; 

SET  :  in  ADA_SQL_FUNCTIONS . SQL_OBJECT; 
WHERE  :  in  ADA_SQL_FUNCTIONS .  SQL_OBJECT  :  = 

ADA_SQL_FUNCTIONS . NULL_SQL_OB JECT  ) 
renames  ADA_SQL_FUNCTIONS . UPDATE; 

end  EXAMPLE  ADA  SQL; 
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package  body  EXAMPLE_ADA_SQL  is 

package  body  DEPT_CORRELAT ION  is 
package  body  NAME  is 

DUMMY  :  ADA_SQL_FUNwj.  J.ONS .  SQL_OBJECT  ;  —  due  to  VAX  bug 
end  NAME; 

end  DEPT_CORRELATION ; 

package  body  EMP_CORRELAT ION  is 
package  body  NAME  is 

DUMMY  :  ADA_SQL_FUNCTIONS. SQL_OBJECT;  —  due  to  VAX  bug 
end  NAME; 

end  EMP_CORRELAT I ON ; 

function  CONVERT_COMPONENT_TO_CHARACTER 

(  C  :  EXAMPLE_TYPES . ADA_SQL . DEPT_LOC_CHARACTER  ) 
return  CHARACTER  is 
begin 

return  CHARACTER  (  C  ) ; 
end  CONVERT_COMPONENT_TO_CHARACTER ; 

function  CONVERT_COMPONENT_TO_CHARACTER 

(  C  :  EXAMPLE_TYPES . ADA_SQL . EMP_NAME_CHARACTER  ) 
return  CHARACTER  is 
begin 

return  CHARACTER  (  C  )  ; 
end  CONVERT_COMPONENT_TO_CHARACTER ; 

function  CONVERT_CHARACTER_TO_COMPONENT  (  C  :  CHARACTER  ) 
return  CHARACTER  is 
begin 

return  C; 

end  CONVERT_CHARACTER_TO_COMPONENT ; 

function  CONVERT_CHARACTER_TO_COMPONENT  (  C  :  CHARACTER  ) 
return  EXAMPLE_TYPES . ADA_£QL . DEPT_LOC_CHARACTER  is 
begin 

return  EXAMPLE_TYPES . ADA_SQL . DEPT_LOC_CHARACTER  (  C  ) ; 
end  CONVERT_CHARACTER_TO_COMPONENT ; 

function  CONVERT_CHARACTER_TO_COMPONENT  (  C:  r  iARACTER  ) 
return  EXAMPLE_TYPES . ADA_SQL . EMP_NAME_CHARACTER  is 
begin 

return  EXAMPLE_TYPES . ADA_SQL . EMP_NAME_CHARACTER  (  C  ), 
end  CONVERT_CHARACTER_TO_COMPONENT ; 

function  COUNT_FUNCTION  is  new 

ADA_SQL_FUNCTIONS . COUNT_STAR  (  ADA  SQL  FUNCTIONS . SQL_OBJLCT  } 
function  COUNT  FUNCTION  is  new 
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ADA_SQL_FUNCTIONS . COUNT_STAR  (  ADA_SQL . DATABASE_TYPE_PACKAGE . INTG_TYPE  ) ; 


function  COUNT  (  STAR  :  STAR_TYPE  )  return  ADA_SQL_FUNCTIONS . SQL_OBJECT  is 
begin 

return  COUNT_FUNCTION; 
end  COUNT; 


function  COUNT  (  STAR  :  STAR_TYPE  ) 
return  ADA_SQL . DATABASE_TYPE_PACKAGE . INTG_TYPE  is 
begin 

return  COUNT_FUNCTION; 
end  COUNT; 


function  SELEC. STAR_SUBQUERY  is  new 
ADA_SQL_FUNCT ION S . STAR_SUBQUERY 

(  ADA_SQL_FUNCTIONS . 0_SELEC  ,  ADA_SQL_FUNCTIONS . SQL_OBJECT  ); 


function  SELEC 
(  WHAT 
FROM 
WHERE 


STAR_TYPE; 

ADA_SQL_FUNCTIONS . TABLE_LIST ; 

AD A_SQL_FUNCT I ON S . SQL_OBJECT  : = 
ADA_SQL_FUNCTIONS . NULL_SQL_OBJECT ; 
ADA_SQL_FUNCTIONS . SQL_OB JECT  : = 
ADA_SQL_FUNCTIONS . NULL_SQL_OBJECT ; 
ADA_SQL_FUNCTIONS . SQL_OBJECT  ; = 
ADA_SQL_FUNCTIONS . NULL_SQL_OBJECT  ) 
return  ADA_SQL_FUNCTIONS . SQL_OBJECT  is 
begin 

return  SELEC_STAR_SUBQUERY  (  FROM  ,  WHERE  ,  GROUP_BY  ,  HAVING  ) ; 
end  SELEC ; 


GROUP_BY 

HAVING 


end  EXAMPLE  ADA  SQL; 


12.  Package  DML_SUBS 


with  TEXT_IO; 
use  TEXT_IO; 
package  DML_SUBS  is 

procedure  FLOAT_TO_STRING 
(NUM  :  in  FLOAT; 

STR  :  in  out  STRING  ) ; 
procedure  TELL_NUM 

(NUM  :  in  STRING; 

CMT  :  in  STRING; 

Q1  :  in  STRING); 
procedure  TELL_NUM_2 
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(NUM 

in 

STRING 

CMT 

in 

STRING 

Q1 

in 

STRING 

Q2 

in 

STRING) 

procedure  TELL_ 

_NUM_ 

_3 

(NUM 

in 

STRING 

CMT 

in 

STRING 

Q1 

in 

STRING 

Q2 

in 

STRING 

Q3 

in 

STRING ) 

procedure  TELL 

_NUM_ 

_4 

(NUM 

in 

STRING 

CMT 

in 

STRING 

Q1 

in 

STRING 

Q2 

in 

STRING 

Q3 

in 

STRING 

Q4 

in 

STRING) 

procedure  TELL_ 

_NUM_ 

_5 

(NUM 

in 

STRING 

CMT 

in 

STRING 

Q1 

in 

STRING 

Q2 

in 

STRING 

Q3 

in 

STRING 

Q4 

in 

STRING 

Q5 

in 

STRING) 

end  DML_SUBS; 

package  body  DML 

SUBS  is 

—  FLOAT_TO_STRING 

procedure  FLOAT_TO_STRING 
(NUM  :  in  FLOAT; 

STR  :  in  out  STRING  )  is 

package  CONVERT_FLOAT  is  new  FLOAT_IO  (FLOAT); 
OVERFLOW  :  STRING  (1..I0)  :=  "******»***",• 

II  :  INTEGER  range  1..10  :=  1; 

begin 

CONVERT_FLOAT .PUT  ( STR ,  NUM ,  2 ,  0 ) ; 

exception 

when  others  =>  STR(1..10)  :=  OVERFLOW  (1..10); 

end  FLOAT_TO_STRING; 
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procedure  TELL_NUM 


in  STRING; 
in  STRING; 
in  STRING)  is 


begin 


PUT_LINE 

(" 

PUT_LINE 

(" 

PUT_LINE 

C 

PUT_LINE 

r 

Example  number 

PUT_LINE 

(" 

PUT_LINE 

(Ql); 

PUT_LINE 

r 

" )  ; 

PUT_LINE 

(" 

end  TELL  NUM; 

&  CMT  ) ; 


—  TELL  NUM  2 


procedure  TELL_NUM_2 


(NUM 

in 

STRING; 

CMT 

in 

STRING; 

Ql 

in 

STRING; 

Q2 

in 

STRING)  is 

begin 

PUT_LINE  ( "  " ) ; 

PUT_LINE  ( "  " ) ; 

PUT_LINE  ( "  "  ) ; 

PUT_LINE  ( "Example  number  "  &  NUM  &  "  unify  page  "  &  CMT  ) ; 
PUT_LINE  ( ”  " ) ; 

PUT_LINE  (Ql); 

PUT_LINE  (Q2); 

PUT_LINE  ( "  ” ) ; 

PUT_LINE  ( "  " ) ; 
end  TELL_NUM_2; 


TELL  NUM  3 


procedure  TELL_NUM_3 


in  STRING; 
in  STRING; 
in  STRING; 
in  STRING; 
in  STRING) 


begin 


AW 
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begin 

PUT_LINE 
PUT_LINE 
PUT_LINE 
PUT_LINE 
PUT_LINE 
PUT_LINE 
PUT_LINE 
PUT_LINE 
PUT_LINE 
PUT_LINE 
PUT_LINE 
PUT  LINE 


r  " )  ; 

C  "); 

C  "); 

("Example  number 
("  "); 

(Ql) 

(Q2) . 

(Q3), 

(Q4) 

(Q5) 

(" 

("  "); 


&  NUM  &  "  unify  page  "  &  CMT  ) ; 


end  TELL_NUM_5; 

end  DML_SUBS; 

5% 


13.  Package  EX_I 


with  EXAMPLE_DDL,  EXAMPLE_TYPES ,  EXAMPLE_VARIABLES ,  DATABASE,  EXAMPLE_ADA_SQL , 
TEXT_IO,  DML_SUBS ; 

use  EXAMPLE_VARIABLES ,  DATABASE,  EXAMPLE_ADA_SQL ,  DML_SUBS; 
package  EX_1  is 
procedure  EXAMPLE_1 ; 
end  EX_1; 

package  body  EX_1  is 

procedure  EXAMPLE_1  is 

use  EXAMPLE_TYPES.ADA_SQL; 

package  MGR  is  new  EMP_CORRELAT ION . NAME  (  "MGR"  ); 

package  X  is  new  EMP_CORRELAT ION .  NAME  (  "X"  )  ,- 

package  MGR_DEPT  is  nexr  DEPT_CORRELATI ON , NAME  (  "MGR_DEPT"  ) ; 

procedure  PUT_LINE  (ITEM  :  in  STRING  )  renames  TEXT_IO .  PUT_LINE,- 
procedure  NEW_LINE  (SPACING  :  in  TEXT_IO . POSITIVE_COUNT  :=  1) 
renames  TEXT_IO . NEW_LINE ; 

procedure  SET_COL  (TO  :  in  TEXT_IO .  POSITIVE_COUNT )  renames  TEXT_IO .  SET_COL,- 
procedure  PUT  (ITEM  :  in  STRING  )  renames  TEXT_IO.PUT; 


F_ELOAT 
F_STRING 
T  LEN 


FLOAT  :  =  0.0,- 
STRING  (I. .10) 
INTEGER  :  =  0  ,- 


:  =  ( others  =  >  '  '  ) 
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T_STRING  :  STRING  (1..100) 
DLI  :  DEPT  LOC  INDEX 


■  (others  => 
1; 


begin 


—  001  from  page  6-6 


TELL_NUM  ("001  6-6 select  *  from  emp">; 


DECLAR  (  CURSOR  ,  CURS0R_F0R  => 
SELEC  (  , 

FROM  =>  EMP  )  ) ; 


OPEN  (  CURSOR  ) ; 


begin 

PUT_LINE  ( "NUMBER  EMP_NAME  DEPT  JOB 

"MANAGER  SALARY  COMMISSION  "), 


loop 

FETCH  (  CURSOR  ) ; 

INTO  (  V_NUMBER  ); 

SET_COL  ( 1 ) ; 

PUT  ( EMP_NUMBER ' IMAGE  ( V_NUMBER ) ) ; 

INTO  (  V_EMP_NAME  ,  STR_LAST  ) ; 

T_LEN  :=  INTEGER  ( STR_LAST  -  V_EMP_NAME ' FIRST  +  1); 
for  I  in  l..T_LEN  loop 

T_STRING  (I)  :=  CHARACTER  (V_EMP_NAME  (V_EMP_NAME' FIRST  +  I  -  1 ) ) 

end  loop; 

SET_C0L  ( 8 ) ; 

PUT  (T_STRING  ( 1 . . T_LEN) ) ; 

INTO  (  V_DEPT  ) ; 

SET_COL  (19); 

PUT  ( DEPT_C0DE ' IMAGE  ( V_DEPT ) ) ; 

INTO  (  V_J OB  ,  JOB_LAST  ) ; 

T_LEN  :=  INTEGER  ( TOB_LAST  -  V_JOB ' FIRST  +  1); 

T_STRING  ( 1 . . T_LEN )  :=  STRING  (V_J0B  (V_JOB'FIRST  ..  J0B_LAST ) ) ; 

SET_COL  (26); 

PUT  ( T_STRING  ( 1 . . T_LEN ) ) ; 

INTO  (  V_MANAGER  ) ; 

SET_C0L  (42); 

PUT  ( EMP_NUMBER ' IMAGE  ( V_MANAGER ) )  ; 

INTO  (  V_SALARY  )  ; 

F_FLOAT  ; =  FLOAT  (  V_SALARY  ) ; 

FLOAT_TO_STRING  ( F_FLOAT,  F_STRING) ; 

SET_COL  (50); 

PUT  ( F_STRING) ; 

INTO  (  V_COMMISSION  ); 

F_FLOAT  :=  FLOAT  (  V_C0MMISSI0N  ); 
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FLOAT_TO_STRING  (F_FLOAT,  F_STRING) 
SET_COL  (60); 

PUT  (F_STRING) ; 
end  loop; 

NEW_LINE; 

exception 

when  N0T_F0UND_ERR0R  =>  null; 
end; 

CLOSE  (  CURSOR  ) ; 


—  002  from  page  6-6 


TELL_NUM  ("002",  " 6-6 "," select  *  from  dept"); 


DECLAR  (  CURSOR  ,  CURSOR_FOR  => 
SELEC  (  ' , 

FROM  =>  DEPT  )  ) ; 

OPEN  (  CURSOR  )  ; 


LOCATION" ) ; 


begin 

PUT_LINE  ("DEPT  DEPT_NAME  LOCATION"); 

loop 

FETCH  (  CURSOR  ) ; 

INTO  (  V_DEPT  ) ; 

SET_COL  (1); 

PUT  ( DEPT_CODE ' IMAGE  ( V_DEPT ) ) ; 

INTO  (  V_DEPT_NAME  ,  STR_LAST  ) ; 

T_LEN  :=  INTEGER  ( STR_LAST  -  V_DEPT_NAME' FIRST  +  1) ; 

T_STRING  ( 1 . . T_LEN )  :=  STRING 

(V_DEPT_NAME  (V_DEPT_NAME ' FIRST  ..  STR_LAST) ) ; 

SET_COL  (10); 

PUT  ( T_STRING  ( 1 . . T_LEN ) ) ; 

INTO  (  V_LOCATION  ,  LOCATION_LAST  ) ; 

T_LEN  :=  INTEGER  ( LOCATION_LAST  -  V_LOCATION ' FIRST  +  1 ) ; 
for  I  in  1 . . T_LEN  loop 

DLI  : =  DEPT_LOC_INDEX  ( I ) ; 

T_STRING  (I)  :=  CHARACTER  (V_LOCATION  ( V_LOCATION ' FIRST  +  DLI 

end  loop; 

SET_COL  (27); 

PUT  ( T_STRING  ( 1 . . T_LEN ) ) ; 
end  loop; 

NEW_LINE; 

exception 

when  NOT_FOUND_ERROR  =>  null; 
end; 
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CLOSE  {  CURSOR  ); 


—  003  from  page  6-7 


TELL_NUM  ( "003" , "6-7" , "select  *  from  taxes"); 

DECLAR  (  CURSOR  ,  CURS0R_F0R  => 

SELEC  (  , 

FROM  =>  TAXES  )  ); 

OPEN  (  CURSOR  ); 


begin 

PUT_LINE  ("MIN_AMOUNT  MAX_AMOUNT  BASE_ 
loop 

FETCH  (  CURSOR  ) ; 

INTO  (  V_MIN_AMOUNT  ); 

F_FLOAT  : =  FLOAT  (  V_MIN_AMOUNT  ) ; 
FLOAT_TO_STRING  (F_FLOAT,  F_STRING) ; 
SET_COL  ( 1 )  ; 

PUT  ( F_STRING ) ; 

INTO  (  V_MAX_AMOUNT  ); 

F_FLOAT  : -  FLOAT  (  V_MAX_AMOUNT ) ; 
FLOAT_TO_STRING  ( F_FLOAT ,  F_STRING) ; 
SET_COL  (12); 

PUT  (F_STRING); 

INTO  (  V_BASE_TAX  ) ; 

F_FLOAT  : =  FLOAT  (  V_BASE_TAX ) ; 
FLOAT_TO_STRING  ( F_FLOAT ,  F_STRING) ; 
SET_COL  (23); 

PUT  (F_STRING) ; 

INTO  (  V_MARGINAL_RATE  ) ; 

F_FL0AT  :=  FLOAT  (  V_MARGINAL_RATE ) ; 
FLOAT_TO_STRING  ( F_FLOAT ,  F_STRING ) ; 
SET_COL  (34); 

PUT  (F_STRING) • 
end  loop; 

NEW_LINE; 

exception 

when  NOT_FOUND_ERROR  =>  null; 
end; 

CLOSE  (  CURSOR  ) ; 


—  004  from  page  6-8 


BASE_TAX  MARGINAL_RATE" ) ; 
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TELL_NUM  ( "004 ", "6-8* , "select  number,  job,  name,  salary  froia  emp"); 

DECLAR  (  CURSOR  ,  CURS0R_F0R  => 

SELEC  (  NUMBER  &  JOB  &  NAME  &  SALARY, 

FROM  ->  EMP  )  ) ; 

OPEN  (  CURSOR  )  ; 

begin 

PUT_LINE  ("NUMBER  JOB  EMP_NAME  SALARY"); 

loop 

FETCH  (  CURSOR  ); 

INTO  (  V_NUMBER  ); 

SET_COL  ( 1 ) ; 

PUT  ( EMP_NUMBER ' IMAGE  { V_NUMBER ) ) ; 

INTO  (  V_J0B  ,  JOB_LAST  ) ; 

T_LEN  :=  INTEGER  (JOB_LAST  -  V_J0B ' FIRST  +  1); 

T_STRING  ( 1 . . T_LEN )  :=  STRING  (V_J0B  (V_JOB'FIRST  ..  JOB_LAST)); 
SET_COL  ( 8 )  ; 

PUT  ( T_STRING  ( 1 . . T_LEN ) ) ; 

INTO  (  V_EMP_NAME  ,  STR_LAST  ) ; 

T_LEN  INTEGER  ( STR_LAST  -  V__EMP_NAME' FIRST  +1); 
for  I  in  1 . . T_LEN  loop 

T_STRING  (I)  :=  CHARACTER  (V__EMP_NAME  (V_EMP_NAME' FIRST  +  I  -  1)); 

end  loop; 

SET_COL  (24); 

PUT  ( T_STRING  ( 1 . . T_LEN ) ) ; 

INTO  (  V_SALARY  ) ; 

F_FLOAT  : =  FLOAT  (  V_SALARY  ) ; 

FLOAT_TO_STRING  ( F__FLOAT ,  F_STRING )  ; 

SET_COL  (40); 

PUT  ( F_STRING ) ; 
end  loop; 

NEW_LINE; 

exception 

when  NOT_FOUND_ERROR  =>  null; 
end; 

CLOSE  (  CURSOR  ) ; 


—  005  from  page  6-9 


TELL_NUM  ( "005" , "6-9" , "select  name,  location  from  dept  where  code  =  FIN") 
begin 

SELEC  (  NAME  S  LOCATION, 

FROM  =>  DEPT, 

WHERE  =>  EQ  (  CODE  ,  FIN  )  );  —  *****  NOTE  USE  OF  ENUMERATION  TYPE 
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PUT_LINE  ("DEPT_NAME  LOCATION"); 

INTO  (  V_DEPT_NAME  ,  STR_LAST  ); 

T_LEN  :»  INTEGER  <STR_LAST  -  V_DEPT_NAME ' FIRST  +  1); 

T_STRING  ( 1 . . T_LEN )  :=  STRING 

(V_DEPT_NAME  ( V_DEPT_NAME ' FIRST  ..  STR_LAST ) ) ; 

SET_COL  (1); 

PUT  (T_STRING  (l..T_LEN)); 

INTO  (  V_LOCATION  ,  LOCATION_LAST  ) ; 

T_LEN  :=  INTEGER  ( LOCATION_LAST  -  V_LOCATION ' FIRST  +  1); 
for  I  in  1 . . T_LEN  loop 

DLI  : »  DEPT_LOC_INDEX  ( I )  ; 

T_STRING  (I)  :=  CHARACTER  (V_LOCATION  ( V_LOCATION ' FIRST  +  DLI  -  1)); 
end  loop; 

SET_COL  ( 17  )  ; 

PUT  (T_STRING  (l..T_LEN)); 

NEWSLINE; 

exception 

when  NOT_FOUND_ERROR  =>  PUT_LINE  ("Selec  not  found"); 
when  UNIQUE_ERROR  =>  PUT_LINE  ("Selec  not  unique"); 
end; 


—  006  from  page  6-10 


TELL_NUM  ( "006" , "6-10" , 

"select  name,  location  from  dept  where  location  =  'Dallas*'"); 


note  that  Ada/SQL  pattern 
matching  comparisons  are 
done  with  LIKE.  Also  note 
Ada/SQL  %,  not  UNIFY  * 

OPEN  (  CURSOR  ) ; 


DECLAR  (  CURSOR  ,  CURSOR_FOR  => 

SELEC  (  NAME  &  LOCATION, 

FROM  =>  DEPT, 

WHERE  =>  LIKE  (  LOCATION  ,  "Dallas*"  )  )  );  — 


begin 

PUT_LINE  ( " DEPT_NAME  LOCATION"); 

loop 

FETCH  (  CURSOR  ) ; 

INTO  (  V_DEPT_NAME  ,  STR_LAST  ) ; 

T_LEN  :=  INTEGER  ( STR_LAST  -  V_DEPT_NAME ' FIRST  +  1); 

T_STRING  ( 1 . . T_LEN )  :=  STRING 

(V_DEPT_NAME  ( V_DEPT_NAME ' FIRST  ..  STR_LAST ) ) ; 

SET_COL  ( 1 ) ; 

PUT  (T_STRING  ( 1 . . T_LEN ) ) ; 

INTO  (  V_LOCATION  ,  LOCATION_LAST  ) ; 

T_LEN  :=  INTEGER  ( LOCATION_LAST  -  V_LOC AT ION' FIRST  +  1); 
for  I  in  1. . T_LEN  loop 

DLI  : =  DEPT_LOC_INDEX  ( I ) ; 

T_STRING  (I)  :=  CHARACTER  (V_LOCATION  ( V_LOCATION ' FIRST  +  DLI  -  1 ) ) ; 


Package  EX_1 


88 


UNCLASSIFIED 


end  loop/ 

SET_COL  ( 17 )  ; 

PUT  ( T_STRING  ( 1 . . T_LEN ) ) ; 
end  loop; 

NEW_LINE; 

exception 

when  NOT_FOUND_ERROR  =>  null; 
end; 


CLOSE  (  CURSOR  ) ; 


—  007  from  page  6-10 


-  example  on  page  6-10  is  not  legal  ANSI  SQL  —  range  of  characters  is  not 

supported  for  string  pattern  matching  —  following  query  skipped 

-  select  Name,  Job 

-  from  emp 

-  where  Name  =  '[A-M]*'  / 

TELL_NUM  ( "007 6-10" , "select  name,  job  from  emp  where  name  =  '[A-M]*'"); 
PUT_LINE  ("This  example  is  not  legal  ANSI  SQL  —  range  of  characters  is  not") 
PUT_LINE  ("supported  for  string  pattern  matching"); 

PUT_LINE  ("This  example  is  not  executed  here"); 


—  008  from  page  6-11 


TELL_NUM  ("008", "6-11  ", 

"select  name,  job  from  emp  where  name 


DECLAR  (  CURSOR  ,  CURS0R_F0R  => 
SELEC  (  NAME  &  JOB, 

FROM  =  >  EMP , 

WHERE  =>  LIKE  (  NAME  ,  " _ 

OPEN  (  CURSOR  ) ; 


agtin  note  LIKE  for  pattern 
matching  comparisons .  Also 
Ada/SQL  underscore  instead 
of  UNIFY  question  mark 


begin 

PUT_LINE  ("EMP_NAME 
loop 

FETCH  (  CURSOR  ) ; 
INTO  (  V_EMP_NAME 


JOB"  ) 


TO  (  V_EMP_NAME  ,  STR_LAST  ) ; 

T_LEN  :=  INTEGER  ( STR_LAST  -  V_EMP_NAME ' FIRST  +  1); 
for  I  in  l..T_LEN  loop 

T_STRING  (I)  :=  CHARACTER  (V_EMP_NAME  ( V_EMP_NAME ' FIRST  +  I 

end  loop,- 
SET_C0L  ( 1 )  ; 


OvSCM 


Package  IiX_l 


v  V  V  *„•  V  ■_«  V  ’>  V'  •  V  V  *  V  v  ■ 


UNCLASSIFIED 


PUT  ( T_STRING  ( 1 . . T_LEN ) ) ; 

INTO  (  V_JOB  ,  JOB_LAST  ) ; 

T_LEN  :=  INTEGER  (JOB_LAST  -  V_JOB' FIRST  +  1); 
T_STRING  ( 1 . . T_LEN )  :=  STRING  (V_JOB  (V_JOB'FIRST 

SET_COL  (17); 

PUT  (T_STRING  ( 1 . . T_LEN) ) ; 
end  loop; 

NEW_LINE ; 
exception 

when  NOT_FOUND_ERROK  =>  null; 
end; 

CLOSE  (  CURSOR  ) ; 


JOB_LAST ) ) ; 


n 


ft 


J 

> 

,  * 

V, 

V, 

H 


\4 


—  009  from  page  6-11 

TELL_NUM  ("009" ,"6-11  ", 

"select  name,  job,  salary,  commission  from  emp  where  commission  >  salary"); 

DECLAR  (  CURSOR  ,  CURS0R_F0R  => 

SELEC  (  NAME  &  JOB  &  SALARY  &  COMMISSION, 

FROM  =  >  EMP , 

WHERE  =>  COMMISSION  >  SALARY  )  ) ; 


£ 


OPEN  (  CURSOR  ) ; 
begin 

PUT_LINE  ( "EMP_NAME  JOB  SALARY  COMMISSION"); 

loop 

FETCH  (  CURSOR  ) ; 

INTO  (  V_EMP_NAME  ,  STR_LAST  ) ; 

T_LEN  :=  INTEGER  ( STR_LAST  -  V_EMP_NAME ' FIRST  +  1); 
for  I  in  1. . T_LEN  loop 

T_SXRING  (I)  :=  CHARACTER  (V_EMP_NAME  (V_EMP_NAME' FIRST  +  I  -  1)); 

end  loop; 

SET_COL  ( 1 ) ; 

PUT  (T_STRING  ( 1 . . T  LEN ) ) ; 

INTO  (  V_JOB  ,  JOB_LAST  ) ; 

T_LEN  :=  INTEGER  (JOB_LAST  -  V_JOB ' FIRST  +  1); 

T_STRING  ( 1 . . T_LEN )  :  =  STRING  (V_JOB  (V_JOB'FIRST  ..  J0B_LAST ) ) ; 

SET_COL  (17); 

PUT  (T_STRING  (l..T_LEN)), 

INTO  (  V_SALARY  ) ; 

F_FLOAT  : =  FLOAT  (  V_SALARY  ) ; 

FLOAT_TO_STRING  ( F_FLOAT ,  F_STRING ) ; 

SET_COL  (33); 

PUT  ( F_STRING ) ; 

INTO  (  V_COMMISSION  ) ; 

F_FLOAT  :=  FLOAT  (  V_COMMISSION  ); 
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FL0AT_T0_STRING  (F_FLOAT,  F_STRING); 
SET_COL  (44); 

PUT  ( F_STRING ) ; 
end  loop; 

NEW_LINE; 

exception 

when  NOT_FOUND_ERROR  ->  null; 
end; 


CLOSE  (  CURSOR  ); 


—  010  from  page  6-12 


TELL_NUM_2  (" 010 6-12 " , 

"select  name,  job,  salary,  dept  from  emp  where  dept  =  ADMIN  and" 
"(job  «  'clerk%'  or  salary  <  =  1200]"); 

DECLAR  (  CURSOR  ,  CURSOR_FOR  => 

SELEC  (  NAME  &  JOB  &  SALARY  &  DEPT,  —  *****  TESTING  NOTE:  DOES  UNIFY 
FROM  =>  EMP,  —  REQUIRE  <  (space)  -  AS  IN 

WHERE  =>  EQ  (  DEPT  ,  ADMIN  )  —  EXAMPLE? 

AND  (  LIKE  (  JOB  ,  "clerk%"  )  or  SALARY  <=  1200.0  )  )  ); 

OPEN  (  CURSOR  ) ; 

begin 

PUT_LINE  ("EMP_NAME  JOB  SALARY  DEPT"); 

loop 

FETCH  (  CURSOR  ); 

INTO  (  V_EMP_NAME  ,  STR_LAST  ) ; 

T_LEN  :=  INTEGER  (STR_LAST  -  V_EMP_NAME' FIRST  +  1) ; 
for  I  in  1. . T_LEN  loop 

T_STRING  (I)  :=  CHARACTER  (V_EMP_NAME  ( V_EMP_NAME ' FIRST  +  I  -  1)); 
end  loop; 

SET_C0L  ( 1 ) ; 

PUT  ( T_STRING  ( 1 . . T_LEN ) ) ; 

INTO  (  V_J0B  ,  J0B_LAST  ) ; 

T_LEN  :=  INTEGER  (J0B_LAST  -  V_J0B'FIRST  +  1); 

T_STRING  ( 1 . . T_LEN )  :=  STRING  (V_J0B  (V_JOB'FIRST  ..  JOB_LAST)); 

SET_C0L  (18); 

PUT  ( T_STRING  ( 1 . . T_LEN ) ) ; 

INTO  (  V_SALARY  ) ; 

F_FLOAT  : =  FLOAT  (  V_SALARY  ) ; 

FLOAT_TO_STRING  (F_FLOAT,  F_STRING) ; 

SET_COL  (35); 

PUT  ( F_STRING ) ; 

INTO  (  V_DEPT  ) ; 

SET_C0L  (47); 
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PUT  { DEPT_CODE ' IMAGE  ( V_DEPT ) ) ; 
end  loop; 

NEW_LINE; 

exception 

when  NOT_FOUND_ERROR  »>  null; 
end; 

CLOSE  (  CURSOR  ) ; 


—  Oil  from  page  6-12 


TELL_NUM  ("Oil  ","6-12", 

"select  name,  salary,  job  from  emp  where  salary  between 

DECLAR  (  CURSOR  ,  CURSOR_FOR  => 

SELEC  (  NAME  &  SALARY  &  JOB, 

FROM  =>  EMP, 

WHERE  =>  BETWEEN  (  SALARY  ,  1500.0  and  2000.0  )  )  );  - 
OPEN  (  CURSOR  ) ; 
begin 

PUT_LINE  ( ” EMP_NAME  SALARY  JOB"); 

loop 

FETCH  (  CURSOR  ) ; 

INTO  (  V_EMP_NAME  ,  STR_LAST  ); 

T_LEN  :=  INTEGER  (STR_LAST  -  V_EMP_NAME' FIRST  +  1); 
for  I  in  1 . . T_LEN  loop 

T_STRING  (I)  :=  CHARACTER  (V_EMP_NAME  (V_EMP_NAME 

end  loop; 

SET_C0L  (1); 

PUT  ( T_STRING  ( 1 . . T_LEN ) ) ; 

INTO  (  V_SALARY  ) ; 

F_FLOAT  :=  FLOAT  (  VJSALARY  ); 

FLOAT_TO_STRING  ( F_FL0AT ,  F_STRING ) ; 

SET_COL  ( 17 ) ; 

PUT  (F_STRING); 

INTO  (  V_JOB  ,  JOB_LAST  ) ; 

T_LEN  :=  INTEGER  (J0B_LAST  -  V_JOB'FIRST  +  1); 
T_STRING  ( 1 . . T_LEN )  :=  STRING  (V_J0B  (V_JOB'FIRST  . 

SET_C0L  (28); 

PUT  (T_STRING  (l..T_LEN)); 
end  loop; 

NEW_LINE; 

exception 

when  NOT_FOUND_ERROR  =>  null; 
end; 


1500.00  and  2000.00") 

—  *****  TESTING 

—  NOTE:  ALSO  TRY 

-  TYPE  QUALIFYING 

-  NUMBERS 


FIRST  +  I  -  1) )  ; 


.  JOB_LAST ) )  ; 
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SALARY" ) ; 


CLOSE  (  CURSOR  ) ; 


—  012  from  page  6-13 


TELL_NUM_2  (" 012" 6-13 " , " select  dept,  name,  job,  salary  from  emp", 

"where  dept  =  RSRCH  and  job  ~=  ' engineer% ' " ) ; 

DECLAR  (  CURSOR  ,  CURS0R_F0R  -) 

SELEC  (  DEPT  &  NAME  &  JOB  &  SALARY, 

FROM  =>  EMP,  —  *****  TESTING  NOTE:  SEE 

WHERE  =*>  EQ  (  DEPT  ,  RSRCH  )  —  IF  UNIFY  HANDLES  NON- 

AND  not  LIKE  (  JOB  .  "engineer%"  )  )  );  —  LEADING  NOT 

OPEN  (  CURSOR  ) ; 

begin 

PUTJLINE  ( "DEPT  EMP_NAME  JOB  SALARY" ) ; 

loop 

FETCH  (  CURSOR  ) ; 

INTO  (  V_DEPT  ) ; 

SET_COL  ( 1 ) ; 

PUT  ( DEPT_CODE ' IMAGE  ( V_DEPT ) ) ; 

INTO  (  V_EMP_NAME  ,  STR_LAST  ); 

T_LEN  :=  INTEGER  ( STR_LAST  -  V_EMP_NAME' FIRST  +  1) ; 
for  I  in  1. . T_LEN  loop 

T_STRING  (I)  :=  CHARACTER  (V_EMP_NAME  (V_EMP_NAME' FIRST  +  I  -  1 ) ) ; 

end  loop; 

SET_C0L  (11); 

PUT  (T_STRING  ( 1 . . T_LEN) ) ; 

INTO  (  V_JOB  ,  JOB_LAST  ) ; 

T_LEN  :=  INTEGER  (JOB_LAST  -  V_J0B' FIRST  +  1); 

T_STRING  ( 1 . . T_LEN )  :=  STRING  (V_J0B  (V_JOB'FIRST  ..  JOB_LAST)); 
SET_COL  (28); 

PUT  ( T_STRING  ( 1 . . T_LEN ) ) ; 

INTO  (  V_S ALARY  ) ; 

F_FL0AT  : =  FLOAT  (  V_SALARY  ) ; 

FLOAT_TO_STRING  ( F_FLOAT ,  F_STRING ) ; 

SET_C0L  (45); 

PUT  ( F_STRING ) ; 
end  loop; 
exception 

when  NOT_FOUND_ERROR  =>  null; 
end; 

CLOSE  (  CURSOR  )  ; 


—  013  from  page  6  13 
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TELL_NUM_2  ( "013" , "6-13" , "select  name,  job,  salary  from  emp  where", 

"not  [job  «  'salesman%'  or  salary  >  =  2000.00]"); 

DECLAR  (  CURSOR  ,  CURS0R_F0R  «> 

SELEC  (  NAME  &  JOB  &  SALARY, 

FROM  =>  EMP, 

WHERE  =>  not  (  LIKE  (  JOB  ,  "salesman^"  )  or  SALARY  >=  2000.0  )  )  ); 
OPEN  (  CURSOR  ) ; 
begin 

PUT_LINE  ("EMF_NAME  JOB  SALARY"); 

loop 

FETCH  (  CURSOR  ); 

INTO  (  V_EMP_NAME  ,  STR_LAST  ) ; 

T_LEN  :=  INTEGER  ( STR_LAST  -  V_EMP_NAME ' FIRST  +  1); 
for  I  in  1 . . T_LEN  loop 

T_STRING  (I)  :=  CHARACTER  (V_EMP_NAME  ( V_EMP_NAME' FIRST  +  I  -  1)); 
end  loop; 

SET_COL  (1); 

PUT  (T_STRING  ( 1 . . T_LEN) ) ; 

INTO  (  V_JOB  ,  JOB_LAST  ) ; 

T_LEN  :=  INTEGER  (JOB_LAST  -  V_J0B' FIRST  +  1); 

T_STRING  ( 1 . . T_LEN )  :=  STRING  (V_J0B  (V_JOB'FIRST  ..  JOB_LAST) ) ; 
SET_COL  (19); 

PUT  ( T_STRING  ( 1 . . T_LEN ) ) ; 

INTO  (  V_SALARY  ) ; 

F_FLOAT  : =  FLOAT  (  V_SALARY  ) ; 

FLOAT_TO_STRING  ( FJFLOAT ,  F_STRING ) ; 

SET_COL  (37); 

PUT  ( F_STRING) ; 
end  loop; 
exception 

when  NOT_FOUND_ERROR  =>  null; 
j  end; 

1  CLOSE  (  CURSOR  ) ; 


—  014  from  page  6-14 


TELL_NUM  ( ”014" , "6-14" , 

"select  name,  job,  dept  from  emp  where  dept  is  in  <ESALES ,  CSALES,  WSALES>") 

DECLAR  (  CURSOR  ,  CURSOR_FOR  => 

SELEC  (  NAME  S  JOB  S  DEPT, 

FROM  =  >  EMP , 
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WHERE  «>  IS_IN  (  DEPT  ,  ESALES  or  CSALES  or  WSALES  )  )  ) ; 

OPEN  (  CURSOR  ) ; 
begin 

PUT_LINE  ( "EMP_NAME  JOB  DEPT"); 

loop 

FETCH  (  CURSOR  ); 

INTO  (  V_EMP_NAME  ,  STR_LAST  ); 

T_LEW  :=  INTEGER  ( STR_LAST  -  V_EMP_NAME' FIRST  +  1), 
for  I  in  1. . T_LEN  loop 

T_STRING  (I)  :=  CHARACTER  ( V_EMP_NAME  (V_EMP_NAME' FIRST  +  I  -  1)); 
end  loop; 

SET_COL  ( 1 )  ; 

PUT  ( T_STRING  ( 1 . . T_LEN ) ) ; 

INTO  (  V_JOB  ,  JOB_LAST  ) ; 

T_LEN  :=  INTEGER  (JOB_LAST  -  V_JOB ' FIRST  +  1); 

T_STRING  ( 1 . . T_LEN )  i=  STRING  (V_JOB  (V_JOB' FIRST  ..  JOB_LAST)); 
SET_COL  (18); 

PUT  ( T_STRING  ( 1 . . T_LEN ) ) ; 

INTO  (  V_DEPT  ) ; 

SET_COL  (35); 

PUT  (DEPT_CODE' IMAGE  (V_DEPT)); 
end  loop; 
exception 

when  NOT_FOUND_ERROR  =>  null; 
end; 


CLOSE  (  CURSOR  ) ; 


—  015  from  page  6-15 

—  example  on  page  6-15  is  not  legal  ANSI  SQL  —  cannot  build  literal  tuples 

—  select  Name,  Job,  Salary,  Dept-No 

—  from  emp 

—  where  <  Job,  Dept_No  >  is  in  (  <  'clerk*'  ,  10  >, 

—  <  'programmer*',  60  >  )  / 

TELL_NUM_2  ( " 015 " , " 6-15" , 

"select  name,  job,  salary,  dept  from  emp  where  <job,  dept>  is  in", 

"(  <  'clerk%',  ADMIN  >,  <  ' programmer % ' ,  RSRCH  >  ) " ) ; 

PUT_LINE  ( 

"This  example  is  not  legal  ANSI  SQL  —  cannot  build  literal  tuples”),- 
PUT_LINE  ("This  example  is  not  executed  here"),- 


—  016  from  page  6-16 
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TELL_NUM  ( "016" , "6-16" , "select  unique  job  from  emp"); 

DECLAR  (  CURSOR  ,  CURS0R_F0R  ->  —  note  Ada/SQL  SELECT_DISTINCT  vs.  UNIFY' s 
SELECT_DISTINCT  (  JOB,  —  SELECT  UNIQUE 

FROM  ->  EMP  )  > 

OPEN  (  CURSOR  ) ; 

begin 

PUT_L1NE  ("JOB"); 
loop 

FETCH  (  CURSOR  ) ; 

INTO  (  V_JOB  ,  J0B_LAST  ) ; 

T_LEN  :=  INTEGER  (JOB_LAST  -  V_JOB' FIRST  +  1); 

T_STR1NG  ( 1 . . T_LEN )  :=  STRING  (V_JOB  (V_JOB' FIRST  ..  JOB_LAST)); 

SET_COL  ( 1 )  ; 

PUT  (T_STRING  (1. .  V_LEN) ) ; 
end  loop; 
exception 

when  NOTJFOUNDJSRROR  =>  null; 
end; 


CLOSE  (  CURSOR  ) ; 

—  017  from  page  6-16 


TELL_NUM_2  (" 017 6-16 select  dept,  job  from  emp  where  dept  is  in”, 
"  <  ADMIN,  ESALES,  CSALES  >  or  salary  >  2000.00"); 

DECLAR  (  CURSOR  ,  CURSOR_FOR  => 

SELEC  (  DEPT  &  JOB, 

FROM  =>  EMP, 

WHERE  =>  IS_IN  (  DEPT  ,  ADMIN  or  ESALES  or  CSALES  ) 

OR  SALARY  >  2000.0  )  ); 

OPEN  (  CURSOR  ) ; 

begin 

PUT_LINE  ("DEPT  JOB”); 

loop 

FETCH  (  CURSOR  ) ; 

INTO  (  V_DEPT  ) ; 

SET_C0L  ( 1 ) ; 

PUT  (DEPT_C0DE' IMAGE  (V_DEPT)); 

INTO  (  V_JOB  ,  J0B_LAST  ) ; 

T_LEN  :=  INTEGER  (JOB_LAST  -  V_J0B ' FIRST  +  1); 

T_STRING  ( 1 , . T_LEN )  :=  STRING  ( V_JOB  (V_JOB'FIRST  ..  J0B_LAST)); 

SET_C0L  (17); 
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PUT  ( T_STRING  { 1 . . T_LEN ) ) ; 
end  loop; 
exception 

when  NOT_FOUND_ERROR  ->  null; 
end; 

CLOSE  (  CURSOR  ) ; 


—  018  from  page  6-17 


TELL_NUM_2  (" 018 6-17 ", "select  unique  dept,  job  from  emp  where  dept  is  in", 
"<  ADMIN,  ESALES,  CSALES  >  or  salary  >  2000.00"); 

DECLAR  (  CURSOR  ,  CURS0R_F0R  => 

SELECT_DISTINCT  (  DEPT  &  JOB, 

FROM  =>  EMP, 

WHERE  =>  IS_IN  (  DEPT  ,  ADMIN  or  ESALES  or  CSALES  ) 

OR  SALARY  >  2000.0  )  ); 

OPEN  (  CURSOR  ) ; 

begin 

PUT_LINE  ("DEPT  JOB"); 

loop 

FETCH  (  CURSOR  ) ; 

INTO  (  V_DEPT  ) ; 

SET_COL  ( 1 )  ; 

PUT  ( DEPT_C0DE ' IMAGE  ( V_DEPT ) ) ; 

INTO  (  V_JOB  ,  JOB_LAST  ) ; 

T_LEN  :=  INTEGER  (JOB_LAST  -  V_JOB' FIRST  +  1) ; 

T_STRING  ( 1 . . T_LEN )  :=  STRING  (V_J0B  (V_J0B' FIRST  ..  JOB_LAST)); 

SET_COL  (19); 

PUT  ( T_STRING  ( 1 . . T_LEN ) ) ; 
end  loop; 
exception 

when  NOT_FOUND_ERROR  =>  null; 
end; 


CLOSE  (  CURSOR  ) ; 


—  019  from  page  6-18 

TELL_NUM_2  (" 019" ," 6-18" , 

"select  name,  job,  salary  +  commission  from  emp  where", 
"dept  is  in  <  ESALES,  CSALES,  WSALES  >"); 
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DECLAR  (  CURSOR  ,  CURSOR_FOR  -> 

SELEC  (  NAME  &  JOB  &  (  SALARY  +  COMMISSION  ) ,  —  note  parentheses 
FROM  **>  EMP,  —  required 

WHERE  ->  IS_IN  (  DEPT  ,  ESALES  or  CSALES  or  WSALES  )  )  ); 

OPEN  (  CURSOR  ) ; 


begin 

PUT_LINE  ( " EMP_NAME  JOB  SALARY+COMMISSION" ) ; 

loop 

FETCH  (  CURSOR  )  ; 

INTO  (  V_EMP_NAME  ,  STR__LAST  )  ; 

T_LEN  INTEGER  ( STR_LAST  -  V_EMP_NAME ' FIRST  +  1); 
for  I  in  1. . T_LEN  loop 

T_STRING  (I)  : -  CHARACTER  (V_EMP_NAME  ( V_EMP_NAME ' FIRST  +  I  -  1)); 
end  loop; 

SET_COL  ( 1 )  ; 

PUT  ( T_STRING  ( 1 . . T_LEN ) ) ; 

INTO  (  V_JOB  ,  JOB_LAST  ); 

T_LEN  :=  INTEGER  (JOB_LAST  -  V_JOB' FIRST  +  1); 

T_STRING  ( 1 . . T_LEN )  :=  STRING  (V_JOB  (V_JOB' FIRST  ..  JOB_LAST) ) ; 

SET_COL  (18); 

PUT  ( T_STRING  ( 1 . . T_LEN ) ) ; 

INTO  (  V_SALARY  ) ; 

F_FLOAT  : =  FLOAT  (  V_SALARY  ) ; 

FLOAT_TO_STRING  ( F_FLOAT ,  F_STRING ) ; 

SET_COL  (35); 

PUT  ( F_STRING) ; 
end  loop; 
exception 

when  NOT_FOUND_ERROR  =>  null; 
end; 

CLOSE  (  CURSOR  )  ; 


—  020  from  page  6-18 


TELL_NUM_2  (  "020" , "6-18" , 

"select  name,  salary,  commission,  (salary  *  0.5  +  100.00)  from  emp", 
"where  commission  <  salary  »  0.5  +  100.00  and  job  =  ' salesman^ ' " ) ; 

DECLAR  (  CURSOR  ,  CURSOR_FOR  => 

SELEC  (  NAME  &  SALARY  &  COMMISSION  S  (  SALARY  *  0.5  +  100.0  ), 

FROM  =  >  EMP , 

WHERE  =>  COMMISSION  <  SALARY  *  0.5  +  100.0 
AND  LIKE  (  JOB  ,  "salesman%"  )  )  ); 

OPEN  (  CURSOR  ) 
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begin 

PUT_LINE  ( " EMP_NAME  SALARY  COMMISSION  SALARY* . 5+100 ") ; 

loop 

FETCH  (  CURSOR  ); 

INTO  {  V_EMP_NAME  ,  STR_LAST  ) ; 

T_LEN  :»  INTEGER  ( STR_LAST  -  V_EMP_NAME' FIRST  +  1); 
for  I  in  1. . T_LEN  loop 

T_STRING  (I)  CHARACTER  ( V_EMP_NAME  ( V_EMP_NAME ' FIRST  +  I  -  1 ) ) / 
end  loop; 

SET_COL  (1); 

PUT  ( T_STRING  ( 1 . . T_LEN ) ) ; 

INTO  (  V_SALARY  ); 

F_FLOAT  :=  FLOAT  (  V_SALARY  ); 

FLOAT_TO_STRING  (F_FLOAT,  F_STRING ) ; 

SET_COL  (18); 

PUT  (F_STRING); 

INTO  (  V__COMMISSION  )  ; 

F_FLOAT  :=  FLOAT  (  V_COMMISSION  ); 

FLOAT_TO_STRING  ( F_FLOAT ,  F_STRING ) ; 

SET_COL  (30); 

PUT  ( F_STRING ) ; 

INTO  (  V_MINIMUM_COMMI SS ION  ) ; 

F_FLOAT  :=  FLOAT  (  V_MINIMUM_COMMISSION ) ; 

FLOAT_TO_STRING  ( F_FLOAT ,  F_STRING); 

SET_COL  (42); 

PUT  ( F_STRING ) ; 
end  loop; 
exception 

when  NOT_FOUND_ERROR  =>  null; 
end; 


CLOSE  (  CURSOR  )  ; 


—  021  from  page  6-19 


—  as  the  below  example  shows,  there  are  some  disadvantages  to  strong 

typing,  and  the  typing  on  the  literals  is  not  really  correct  anyway,  but 

—  mostly  for  convenience 

—  note  that  arithmetic-type  operations  not  including  a  database  value  will 

be  processed  totally  by  Ada,  so  individual  operands  will  not  go  to  the 
database.  (These  operations  may  not  be  redefined!)  To  get  values  to 
the  database  here,  INDICATOR  is  used  to  build  a  "database"  value  from 
the  literal.  Note  that  a  literal  parameter  to  INDICATOR  may  require 
explicit  type  specification  to  establish  typing. 

TELL_NUM_3  ("021  ","6-19",  "select  (3000  *  12)  +  5000,  base_tax,", 

"(((  3000  *  12  )  +  5000;  -  min_amount  )  *  marginax_rate" , 

"from  taxes  where  (  3000  *  12  )  +  5000  between  min_amount  and  max_amount " ) 
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PUT_LINE  ( 

"in  this  example  the  arithemetic  values  are  passed  to  the  database"),- 
PUT_LINE  ( "  " ) ; 

PUT_LINE  ( "  " ) ; 

Degin 

PUT_LINE  ("3000*12+5000  BASE_TAX  "  & 

" ( ( ( 3 000*12) +5000 )-MIN_AMOUNT) *MARGINAL_RATE" ) ,- 
SELEC  (  (  INDICATOR  (  EXAMPLEJTYPES . ADA_SQL . ANNUAL_PAY ' ( 3000 . 0 )  )  *  12 . 0  + 
5000.0  )  & 

BASE_TAX  & 

CONVERT _TO . EXAMPLE_TYPES . TAX_AMOUNT 

(  CONVERT_TO . EXAMPLEJTYPES . TAX_COMPUTATION_PRECISION 

(  INDICATOR  (  EXAMPLEJTYPES . ADA_SQL . ANNUAL_PAY ' (3000. 0)  )  *  12.0 
+  5000.0  -  MIN_AMOUNT  )  * 

CONVERT  JTO . EXAMPLEJTYPES . TAX_COMP  UT AT I ON_P  REC I S I ON 
(  MARGINALJ1ATE  )  ) , 

FROM  =  >  TAXES , 

WHERE  =>  BETWEEN 

(  INDICATOR  (  EXAMPLEJTYPES  ADA_SQL . ANNUAL JP AY ' (  3000.0)  )  *  12.0  + 
5000.0, 

MIN_AMOUNT  and  MAX_AMO UNT  )  ) ; 

INTO  (  V_ANNUAL_PAY  ) ; 

F_FLOAT  :=  FLOAT  (  V_ANNUAL_PAY ) ; 

FLOAT_TO_STR ING  ( F_FLOAT ,  F_STRING); 

SET_COL  (1); 

PUT  (F_STRING); 

INTO  (  V_BASF_TAX  )  ; 

F_FLOAT  :  =  FLOAT  (  VJ3ASEJTAX)  ; 

FLOAT JTO_STRING  ( F_FLOAT ,  F_STRING ) ; 

SET_COL  (14); 

PUT  (F_STPTNG); 

INTO  (  V_EXTRA_TAX  ) ; 

F_FLOAT  : =  FLOAT  (  V_EXTRA_TAX  ) ; 

FLOAT_TO_STRING  (F_FLOAT,  F_STRING ) ; 

SET_COL  (30); 

PUT  ( F_STRING ) ; 
exception 

when  NOT_FOUND_ERROR  =>  PUT_LINE  ("Selec  not  found"); 
when  UNIQUE_ERROR  »>  PUT_LINE  ("Selec  not  unique"); 
end; 


—  022  derived  from  example  on  page  6-19 


here  is  the  above  example  redone  with  the  literal  math  performed  by  Ada 
Note  the  difference  in  what  goes  to  the  database. 

Also  note  that  there  is  still  a  disadvantage  to  strong  typing  when 
operating  on  expressions  that  make  sense,  although  they  involve 
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TELL_NUM_3  (" 022" 6-19  modified" , 

"select  (3000  *  12)  +  5000,  base_tax,", 

"(((  3000  *  12  )  +  5000)  -  min_amount  )  *  marginal_rate" , 

"from  taxes  where  (  3000  *  12  )  +  5000  between  min_amount  and  max_amount" ) 
PUTJLINE  ( 

"this  is  the  above  example  redone  with  the  literal  math  performed  by  Ada"); 
PUT_LINE  ( "  " ) ; 

PUTJLINE  ("  "); 

begin 

PUT_LINE  ("3000*12+5000  BASE_TAX  "  & 

"(( (3000*12) +5000) -MIN_AMOUNT) *MARGINAL_RATE" ) , 

SELEC  (  (  3000.0  *  12.0  +  5000.0  )  & 

BASE_TAX  & 

CONVERT_TO . EXAMPLE_TYPES . TAX_AMOUNT 

(  CONVERT_TO . EXAMP L E_TYP E S . TAX_COMPUTATION_PRECISION 
(  3000.0  *  12.0  +  5000.0  -  M I N_ AMOUNT  )  * 

CONVERT_TO . EXAMPLE_TYPES . TAX_COMPUTATION_PRECISION 
(  MARGINAL_RATE  )  ) , 

FROM  =>  TAXES, 

WHERE  =>  BETWEEN  (  3000.0  *  12.0  +  5000.0  ,  MIN_AMOUNT  and  MAX_AMO UNT  )  ); 

INTO  (  V_ANNUAL_PAY  ) ; 

F_FLOAT  :=  FLOAT  (  V_ANNUAL_PAY ) ; 

FLOAT_TO_STRING  ( F_FLOAT ,  F_STRING) ; 

SET_C0L  ( 1 ) ; 

PUT  ( F_STRING ) ; 

INTO  (  V_BASE_TAX  ) ; 

F_FLOAT  :=  FLOAT  (  V_BASE_TAX) ; 

FLOAT_TO_STRING  ( F_FLOAT ,  F_STRING) ; 

SET_COL  (14); 

PUT  ( F_STRING ) ; 

INTO  (  V_EXT RA_T AX  ) ; 

F_FLOAT  : =  FLOAT  (  V_EXTRA_TAX  ) ; 

FLOAT_TO_STRING  ( F_FLOAT ,  F_STRING ) ; 

SET_COL  (30); 

PUT  ( F_STRING ) ; 
exception 

when  NOT_FOUND_ERROR  =>  PUT_LINE  ("Selec  not  found"); 
when  UN I QUE_ERROR  =>  PUT_LINE  ("Selec  not  unique"); 
end; 


—  023  from  page  6-20 


TELL__NUM  ( "023" , "6-20" , "select  number,  name,  job  from  emp  order  by  number"); 
DECLAR  (  CURSOR  ,  CURS0R_F0R  => 
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SELEC  (  NUMBER  &  NAME  &  JOB, 

FROM  ->  EMP  ) , 

ORDER_BY  =>  NUMBER  ) ; 

OPEN  (  CURSOR  ) ; 

begin 

PUT_LINE  ("NUMBER  EMP_NAME  JOB"); 

loop 

FETCH  (  CURSOR  )  ; 

INTO  (  V_NUMBER  ) ; 

SET_COL  ( 1 )  ; 

PUT  ( EMP_NUMBER ' IMAGE  (V_NUMBER) ) ; 

INTO  (  V_EMP_NAME  ,  STR_LAST  ) ; 

T_LEN  :=  INTEGER  ( STR_LAST  -  V_EMP_NAME ' FIRST  +  1); 
for  I  in  1. . T_LEN  loop 

T_STRING  (I)  :=  CHARACTER  (V_EMP_NAME  ( V_EMP_NAME ' FIRST  +  I  - 

end  loop; 

SET_COL  ( 9 ) ; 

PUT  ( T_STRING  ( 1 . . T_LEN ) ) ; 

INTO  (  V_JOB  ,  JOB_LAST  ) ; 

T_LEN  :=  INTEGER  (JOB_LAST  -  V_JOB' FIRST  +  1); 

T_STRING  ( 1 . . T_LEN)  : =  STRING  (V_JOB  (V_JOB'FIRST  ..  JOB_LAST)) 
SET_COL  (26); 

PUT  (T_STRING  (l..T_LEN)); 
end  loop; 
exception 

when  NOT_FOUND_ERROR  =>  null; 
end; 


|  CLOSE  (  CURSOR  ) ; 

i 

—  024  from  page  6-21 


TELL_NUM  ("024", "6-21  ", 

"select  dept,  name,  job  from  emp  order  by  dept  desc,  name  asc" 

DECLAR  (  CURSOR  ,  CURSOR_FOR  => 

SELEC  (  DEPT  S  NAME  S  JOB, 

FROM  =  >  EMP  )  , 

ORDER_BY  =>  DESC  (  DEPT  )  &  ASC  (  NAME  )  ); 

OPEN  (  CURSOR  )  ; 
begin 

PUT_LINE  ("DEPT  EMP_NAME  JOB"); 

loop 

FETCH  (  CURSOR  ) ; 
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INTO  (  V_DEPT  ) ; 

SET_COL  (1); 

PUT  ( DEPT_CODE ' IMAGE  ( V_DEPT ) ) ; 

INTO  (  V_EMP_NAME  ,  STR_LAST  ) ; 

T_LEN  INTEGER  ( STR_LAST  -  V__EMP_NAME' FIRST  +  1); 
for  I  in  1 . . T_LEN  loop 

T_STRING  (I)  :=  CHARACTER  (V_EMP_NAME  (V_EMP_NAME' FIRST  +  I  -  1 ) ) 

end  loop; 

SET_COL  (18); 

PUT  ( T_STRING  ( 1 . . T_LEN ) ) ; 

INTO  (  V_JOB  ,  JOB_LAST  ); 

T_LEN  INTEGER  (JOB_LAST  -  V_JOB'FIRST  +  1); 

T_STRING  ( 1 . . T_LEN )  :«  STRING  (V_JOB  (V_JOB'FIRST  ..  JOB_LAST) ) ; 
SET_COL  (35); 

PUT  ( T_STRING  ( 1 . . T_LEN ) ) ; 
end  loop; 
exception 

when  NOT_FOUND_ERROR  =>  null; 
end; 

CLOSE  (  CURSOR  ) ; 


—  025  from  page  6-22 


TELL_NUM  ( "025" , "6-22" , "select  count  (*)  from  emp  where  dept  =  ADMIN"), 
begin 

PUT_LINE  ( "COUNT  (*)"); 

SELEC  (  COUNT  ('*'), 

FROM  =>  EMP, 

WHERE  =>  EQ  (  DEPT  ,  ADMIN  )  ); 

INTO  (  COUNT_RESULT  )  ; 

SET_C0L  ( 1 ) ; 

PUT  ( DATABASE . INTG ' IMAGE  ( COUNT_RESULT ) ) ; 
exception 

when  NOT_FOUND_ERROR  =>  PUT_LINE  ("Selec  not  found"); 
when  UNIQUE_ERROR  =>  PUT_LINE  ("Selec  not  unique"); 
end; 

end  EXAMPLE_1 ; 
end  EX  1; 


14.  Package  EX_2 


with  EXAMPLE_DDL,  EXAMPLE_TYPES ,  EXAMPLE_VARIABLES ,  DATABASE,  EXAMPLE_ADA_SQL , 
TEXT_IO ,  DML  SUBS; 
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use  EXAMPLE.  VARIABLES,  DATABASE,  EXAMPLE_ADA_SQL , 

DML_SUBS; 
package  EX_2  is 

procedure  EXAMPLE_2; 

end  EX_2; 

package  body  EX_2  is 

procedure  EXAMPLE_2  is 

use  EXAMPLE_TYPES . ADA_SQL; 

package  MGR  is  new  EMP_CORRELATION . NAME  (  "MGR"  ); 

package  X  is  new  EMP_CORRELAT ION. NAME  (  "X"  ); 

package  MGR_DEPT  is  new  DEPT_CORRELATION . NAME  (  "MGR_DEPT"  ); 

procedure  PUT_LINE  (ITEM  :  in  STRING  )  renames  TEXT_IO. PUT_LINE; 
procedure  NEW_LINE  (SPACING  :  in  TEXT_IO. POSITIVE_COUNT  :=  1) 
renames  TEXT_IO . NEW_LINE; 

procedure  SET_COL  (TC  :  in  TEXT_IO . POSITIVE_COUNT)  renames  TEXT_IO . SET_COL; 
procedure  PUT  (ITEM  :  in  STRING  )  renames  TEXT_IO. PUT; 

F_FLOAT  :  FLOAT  : =  0.0; 

F_STRING  :  STRING  (1..10)  :=  (others  =>  '  '); 

T_LEN  :  INTEGER  :=  0; 

T_STRING  :  STRING  (1..100)  (others  =>  '  '); 

DLI  :  DEPT_LOC_INDEX  :=  1; 


begin 


—  026  from  page  6-22 


TELL_NUM  ( "026" , "6-22" , "select  min  (salary),  max 
begin 

PUT_LINE  ( "MIN( SALARY)  MAX ( SALARY )") ; 

SELEC  (  MIN  (  SALARY  )  &  MAX  (  SALARY  ) , 

FROM  =  >  EMP  ) ; 

INTO  (  V_SALARY  ) ; 

F_FL0AT  : =  FLOAT  (  V_SALARY  ) ; 

FLOAT_TO_STRING  (F_FL0AT,  F_STRING ) ; 

SET_C0L  ( 1 ) ; 

PUT  ( F_STRING ) ; 

INTO  (  V_MAX_S ALARY  )  ; 

F_FL0AT  : =  FLOAT  (  V_MAX_S ALARY  ) ; 
FLOAT_TO_STRING  ( F_FLOAT ,  F_STRING ) ; 
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SET_COL  (17); 
PUT  (F_STRING); 
exception 


when  NOT_FOUND_ERROR  =>  PUT_LINE  ("Selec  not  found"); 
when  UNIQUE_ERROR  ->  PUT_LINE  ("Selec  not  unique"); 
end; 


—  027  from  6-23 

—  example  on  page  6-23  is  not  legal  ANSI  SQL  —  when  selecting  without 

—  groups,  if  one  <value  expression>  in  the  <select  list>  includes  a  <set 
function  specif ication> ,  then  all  <column  specif ication>s  in  the  <select 

—  list>  must  be  contained  within  <set  function  specif ication>s 

—  select  Job,  avg  (  Salary  +  Commission  ) 

—  from  emp 

—  where  Job  =  'salesman*'  / 

TELL_NUM  ("027 ","6-23", 

"select  job,  avg  (salary  +  commission)  from  emp  where  job  =  ' salesman% ' " ) ; 
PUT_LINE  ("This  example  is  not  legal  ANSI  SQL  —  when  s  iecting  without"); 
PUT_LINE  ( 

"groups,  if  one  <value  expression)  in  the  <select  list)  includes  a  <set"); 
PUTJLINE  ( 

"function  specification),  then  all  <column  specif ication)s  in  the  <select") 
PUT_LINE  ("list)  must  be  contained  within  <set  function  specification^"); 
PUT_LINE  ("This  example  is  not  executed  here"); 


—  028  from  6-23 


TELL_NUM_2  ( "028" , "6-23"  , 

"select  sum  ((  salary  *  12  )  +  commission)  from  emp", 
"where  job  =  'engineer%'  or  job  =  ' programmed ' " ) ; 


begin 

PUT_LINE  ( "SUM( SALARY+COMMISSION) " ) ; 

SELEC  (  C0NVERT_T0 . EXAMPLE_TYPES . T0TAL_PAY 
(  SUM  (  SALARY  *  12.0  +  COMMISSION 
FROM  =>  EMP, 

WHERE  =>  LIKE  (  JOB  ,  "engineer%"  )  or  LIKE 
INTO  (  V_TOTAL_PAY  ) ; 

F_FL0AT  :=  FLOAT  (  V_TOTAL_PAY  ); 

FL0AT_T0_STRING  ( F_FLOAT ,  F_STRING) ; 

SET_C0L  (1); 

PUT  (F_STRING) ; 
exception 

when  N0T_F0UND_ERR0R  =>  PUT_LINE  ("Selec  not  found"); 


—  type  conversion  needed 
)  ) ,  —  to  allow  for  expanded 

—  range 

(  JOB  ,  "programmed"  )  ); 


105 


Package  EX_2 


UNCLASSIFIED 


when  UN I QUE_ERROR  ->  PUT_LINE  ("Selec  not  unique"); 
end; 

—  types  are  not  precisely  correct  in  above  —  should  convert  both  SALARY 

—  and  COMMISSION  before  computation  to  allow  for  correct  ranges,  but  no 

—  existing  databases  range  check,  so  we  took  the  easy  way  out 

—  029  from  page  6-24 

TELL_NUM  ("029 ","6-24", 

"select  dept,  count  (*),  sum  (  salary  +  commission  )  from  emp  group  by  dept"); 

DECLAR  (  CURSOR  ,  CURS0R_F0R  => 

SELEC  (  DEPT  &  COUNT  (  '  * '  )  & 

CONVERT__TO . EXAMPLE_TYPES . T0TAL_PAY  —  see  type  conversion 
(  SUM  (  SALARY  +  COMMISSION  )  ),  —  comments  above 

FROM  ->  EMP, 

GR0UP_BY  =■>  DEPT  )  ); 

OPEN  (  CURSOR  ) ; 

begin 

PUT_LINE  ( "OEPT  COUNT(*)  SUM( SALARY+COMMISSION) " ) ; 

loop 

FETCH  (  CURSOR  ); 

INTO  (  V_DEPT  ) ; 

SET_C0L  (1); 

PUT  (DEPT_C0DE' IMAGE  (V_DEPT) ) ; 

INTO  (  COUNT_RESULT  ); 

SET_COL  (18); 

PUT  ( DATABASE . INTG ' IMAGE  ( COUNT_RESULT ) ) ; 

INTO  (  V_TOTAL_PAY  ) ; 

F_FLOAT  : -  FLOAT  (  V_TOTAL_PAY  ) ; 

FLOAT_TO_STRING  ( F_FLOAT ,  F_STRING ) ; 

SET_COL  (30); 

PUT  (F_STRING) ; 
end  loop; 
exception 

when  NOT_FOUND_ERROR  =>  null; 
end; 

CLOSE  (  CURSOR  ) ; 


—  030  from  page  6-24 


'TIELL_NUM_2  ("030",  "6-24”, 
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"select  dept,  job,  count  (*)  avg  (  salary  )  from  emp", 

"where  dept  is  in  <ADMIN,  ESALES,  CSALES  >  group  by  dept,  job"); 

DECLAR  (  CURSOR  ,  CURSOR_FOR  -> 

SELEC  (  DEPT  &  JOB  &  COUNT ('*')  &  AVG  (  SALARY  ), 

FROM  ->  EMP, 

WHERE  =>  IS_IN  (  DEPT  ,  ADMIN  or  ESALES  or  CSALES  ), 

GROUP_BY  ->  DEPT  &  JOB  )  ); 

OPEN  (  CURSOR  ); 

begin 

PUT_LINE  ("DEPT  JOB  COUNT( *)  AVG ( SALARY )") ; 

loop 

FETCH  (  CURSOR  ); 

INTO  (  V_DEPT  ); 

SET_COL  (1); 

PUT  ( DEPT_CODE ' IMAGE  ( V_DEPT ) ) ; 

INTO  (  V_JOB  ,  JOB_LAST  ); 

T_LEN  :=  INTEGER  (JOB_LAST  -  V_JOB' FIRST  +  1); 

T_STRING  ( 1 . . T_LEN )  :=  STRING  (V_JOB  (V_JOB' FIRST  ..  JOB_LAST) ) ; 
SET_COL  (13); 

PUT  ( T_STRING  ( 1 . . T_LEN ) ) ; 

INTO  (  COUNT_RESULT  ) ; 

SET_COL  (30); 

PUT  ( DATABASE . INTG ' IMAGE  ( C0UNT_RESULT ) ) ; 

INTO  (  V_SALARY  ) ; 

F_FLOAT  : =  FLOAT  (  V_SALARY  ) ; 

FLOAT_TO_STRING  ( F_FL0AT ,  F_STRING); 

SET_COL  (45); 

PUT  ( F_STRING ) ; 
end  loop; 
exception 

when  NOT_FOUND_ERROR  =>  null; 
end; 

CLOSE  (  CURSOR  ) ; 


—  031  from  page  6-25 

TELL_NUM_2  ("031  ","6-25", 

"select  dept,  count  (*),  avg  ((  salary  *  12  )  +  commission)", 

"from  emp  where  job  =  'salesman%'  group  by  dept"); 

DECLAR  (  CURSOR  ,  CURSOR_FOR  => 

SELEC  (  DEPT  &  COUNT('*')  & 

CONVERT_TO.EXAMPLE_TYPES. ANNUAL_PAY  —  see  comments  above 

(  AVG  (  SALARY  *  12.0  +  COMMISSION  )  ),  —  on  type  conversion 
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FROM  «>  EMP, 

WHERE  =>  LIKE  (  JOB  ,  "salesman%"  ), 

GROUP_BY  =>  DEPT  )  ); 

OPEN  (  CURSOR  ) ; 

begin 

PUT_LINE  ("DEPT  COUNT(*)  AVG( ( SALARY*12 ) +COMMISSION) " ) ; 

loop 

FETCH  (  CURSOR  ) ; 

INTO  (  V_DEPT  ) ; 

SET_COL  (1); 

PUT  (DEPT_CODE' IMAGE  (V_DEPT)); 

INTO  (  COUNT_RE S ULT  ); 

SET_COL  (13); 

PUT  (DATABASE. INTG' IMAGE  (COUNT_RESULT) ) ; 

INTO  (  V_ANNUAL_PAY  ) ; 

F_FLOAT  :=  FLOAT  (  V_ANNUAL_PAY) ; 

FLOAT_TO_STRING  ( F_FLOAT ,  F_STRING ) ; 

SET_COL  (27); 

PUT  (F_STRING); 
end  loop ; 
exception 

When  NOT_FOUND_ERROR  =>  null; 
end; 

CLOSE  (  CURSOR  ) ; 


—  032  from  page  6-25 

—  example  on  page  6-25  is  not  legal  ANSI  SQL  —  one  <set  function 

—  specif ication>  cannot  be  included  within  another  one 

—  select  avg  (  count (*)  ) 

—  from  emp 

—  group  by  Dept_No  / 

TELL_NUM  ( "032” , "6-25" , "select  avg  (count  (*))  from  emp  group  by  dept"); 
PUT_LINE  ("This  example  is  not  legal  ANSI  SQL  —  one  <set  function” ) ; 
PUT_LINE  ( "specif ication>  cannot  be  included  within  another  one"); 
PUT_LINE  ("This  example  is  not  executed  here"); 


—  033  from  page  6-26 

—  likewise  for  example  on  page  6-26 

—  select  max  (  avg  (  Salary  )  ) 

—  from  emp 

—  where  Job  ~=  'president*' 

—  group  by  Job  / 
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TELL_NUM  ( "033" , "6-26" , "select  max  (  avg  (  salary  )  )  "  s 
"from  emp  where  job  'president%'  group  by  job"); 

PUT_LINE  ("This  example  is  not  legal  ANSI  SQL  —  one  <set  function"); 
PUT_LINE  ("specification)  cannot  be  included  within  another  one"); 
PUT_LINE  ("This  example  is  not  executed  here"); 


—  034  from  page  6-27 


TELL_NUM_2  (" 034  ", "6-27 " , 

"select  name,  job  from  emp  where  salary  +  commission  =", 
"  select  max  (  salary  +  commission)  from  emp"); 

DECLAR  (  CURSOR  ,  CURS0R_F0R  -> 

SELEC  (  NAME  &  JOB, 

FROM  *>  EMP, 

WHERE  =>  EQ  (  SALARY  +  COMMISSION, 

SELEC  (  MAX  (  SALARY  +  COMMISSION  ), 

FROM  =>  EMP  )  )  )  ); 

OPEN  (  CURSOR  ) ; 


begin 

PUT_LINE  ( " EMP_NAME  JOB"); 

loop 

FETCH  (  CURSOR  )  ; 

INTO  (  V_EMP_NAME  ,  STR_LAST  ); 

T_LEN  :=  INTEGER  ( STR_LAST  -  V_EMP_NAME' FIRST  +  1); 
for  I  in  1. . T_LEN  loop 

T_STRING  (I)  :=  CHARACTER  (V_EMP_NAME  (V_EMP_NAME' FIRST  +  I  -  1)); 
end  loop; 

SET_COL  ( 1 ) ; 

PUT  ( T_STRING  ( 1 . . T_LEN ) ) ; 

INTO  (  V_J0B  ,  J0B_LAST  ) ; 

T_LEN  :=  INTEGER  (J0B_LAST  -  V_J0B' FIRST  +  1); 

T_STRING  ( 1 . . T_LEN )  :=  STRING  (V_J0B  (V_JOB'FIRST  ..  J0B_LAST ) ) ; 

SET_C0L  (18); 

PUT  ( T_STRING  ( 1 . . T_LEN ) ) ; 
end  loop ; 
exception 

when  N0T_F0UND_ERR0R  =>  null; 
end; 


CLOSE  (  CURSOR  ) ; 


—  035  from  page  6-27 

—  example  on  page  6-27  is  not  legal  ANSI  SQL  —  subqueries  can  only  compare 
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—  one  value  at  a  time,  not  tuples  of  values 

—  select  Name,  Job,  Salary 

—  from  emp 

—  where  Dept_No  10 

—  and  <  Job,  Salary  >  is  in 

select  Job,  Salary 
from  emp 

where  Dept_No  =  10  / 

TELL_NUM_3  (" 035 6-27 " ,  "select  name,  job,  salary  .irom  emp", 

"  where  dept  ADMIN  and  <  job,  salary  >  is  in", 

"  select  job,  salary  from  emp  where  dept  =  ADMIN"),- 

PUT_LINE  ( 

"This  example  is  not  legal  ANSI  SQL  —  subgueries  can  only  compare"),- 
PUT_LINE  ("one  value  at  a  time,  not  tuples  of  values"),- 
PUT_LINE  ("This  example  is  not  executed  here"),- 


—  036  from  page  6-28 


t;  ’ 


TELL_NUM_4  (" 036 "," 6-28 "," select  dept,  name,  job,  salary  +  commission  "  & 
"from  emp  where  salary  +  commission  =", 

"  select  max  (  salary  +  commission  )  from  emp  where  name  “=", 

"  select  name  from  emp  where  salary  +  commission  =", 

"  select  max  (  salary  +  commission  )  from  emp"); 

DECLAR  (  CURSOR  ,  CURS0R_F0R  => 

SELEC  (  DEPT  &  NAME  &  JOB  &  (  SALARY  +  COMMISSION  ) , 

FROM  =  >  EMP , 

WHERE  =>  EQ  (  SALARY  +  COMMISSION, 

SELEC  (  MAX  (  SALARY  +  COMMISSION  ) , 

FROM  =>  EMP, 

WHERE  =>  NE  (  NAME, 

SELEC  (  NAME, 

FROM  =>  EMP, 

WHERE  =>  EQ  (  SALARY  +  COMMISSION, 

SELEC  (  MAX  (  SALARY  +  COMMISSION  ), 

FROM  =>  EMP  )))))))); 

OPEN  (  CURSOR  ) ; 


begin 

PUT_LINE  ("DEPT  EMP_NAME  JOB  SALARY+COMMISSION"  )  ,- 

loop 

FETCH  (  CURSOR  ) ; 

INTO  (  V_DEPT  ) ; 

SET_C0L  ( 1 )  ,- 

PUT  ( DEPT_C0DE ' IMAGE  ( V_DEPT ) ) ; 

INTO  (  V_EMP_NAME  ,  STR_LAST  ) ; 
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T_LEN  INTEGER  (STR_LAST  -  V_EMP_NAME' FIRST  +  1); 
for  I  in  1.  .  T_LEN  loop 

T_STRING  (I)  :=  CHARACTER  (V_EMP_NAME  (VJEMPJNAME' FIRST  +  I  -  1)); 
end  loop; 

SET_COL  (13); 

PUT  ( T_STRING  ( 1 . . T_LEN ) ) ; 

INTO  (  V_JOB  ,  JOB_LAST  ); 

T_LEN  INTEGER  (JOB_LAST  -  V_JOb  FIRST  +  1)  ; 

T_STRING  ( 1 . . T_LEN )  :=  STRING  <V_JOB  (V_JOB' FIRST  ..  JOB_LAST)); 

SET_COL  (30); 

PUT  ( T_STRING  ( 1 . . T_LEN ) ) ; 

INTO  {  V_SALARY  ); 

F_FL0AT  :«  FLOAT  (  V_SALARY  ); 

FLOAT_TO_STRING  ( F_FL0AT ,  F_STRING); 

SET_C0L  (47); 

PUT  (F_STRING); 
end  loop; 
exception 

when  NOT_FOUND_ERROR  =>  null; 
end; 


CLOSE  (  CURSOR  ); 


—  037  from  page  6-29 


TELL_NUM_4  (" 037 6-29 "  , 

"select  dept,  name,  job,  salary  +  commission,  commission  from  emp" , 

"  where  salary  +  commission  =  select  max  (  salary  +  commission  )  from  emp", 

"  where  job  =  'salesman%';  or  [  job  =  'salesman*'  and  dept  =  ESALES  ]", 

"  order  by  commission  desc,  salary  desc"); 

DECLAR  (  CURSOR  ,  CURS0R_F0R  => 

SELEC  (  DEPT  &  NAME  &  JOB  &  (  SALARY  +  COMMISSION  )  &  COMMISSION, 

FROM  =  >  EMP , 

WHERE  =>  EQ  (  SALARY  +  COMMISSION,  —  function  parentheses  group 

SELEC  (  MAX  (  SALARY  +  COMMISSION  ),  —  Ada/SQL  subqueries;  something 
FROM  =>  EMP,  —  like  UNIFY  ;  is  not  needed 

WHERE  =>  LIKE  (  JOB  ,  "salesman*"  )  )  ) 

OR  (  LIKE  (  JOB  ,  "salesman*"  )  and  EQ  (  DEPT  ,  ESALES  )  )  ), 

0RDER_BY  =>  DESC  (  COMMISSION  )  &  DESC  (  SALARY  )  ); 

OPEN  (  CURSOR  ) ; 

begin 

PUT_LINE  ( "DEPT  EMP_NAM£  JOB  "  & 

"  SALARY  COMMISSION"); 

loop 

FETCH  (  CURSOR  ) ; 
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INTO  (  V_DEPT  )  ; 

SET_COL  (1); 

PUT  (DEPT_CODE' IMAGE  (V_DEPT)); 

INTO  (  V_EMP_NAME  ,  STR_LAST  ) ; 

T_LEN  INTEGER  (STR_LAST  -  V_EMP_NAME' FIRST  +  1); 
for  I  in  1 . . T_LEN  loop 

T_STRING  (I)  :=  CHARACTER  ( V_EMP_NAME  ( V_EMP_NAME 'FIRST  +  I  -  1)); 

end  loop;  ! 

SET_COL  (18); 

PUT  ( T_STRING  ( 1 . . T_LEN ) ) ; 

INTO  (  V_JOB  ,  JOB_LAST  ); 

T_LEN  :=■  INTEGER  (JOB_LAST  -  V_JOB' FIRST  +  1)  ; 

T_STRING  (l..T_LEN)  :=  STRING  (V_JOB  (V_JOB' FIRST  ..  JOB_LAST)); 

SET_COL  (35); 

PUT  ( T_STRING  ( 1 .  . T_LEN ) ) ; 

INTO  (  V_SALARY  ) ; 

F_FLOAT  :=  FLOAT  (  V_SALARY  ); 

FLOAT_TO_STRING  ( F_FLOAT ,  F_STRING); 

SET_COL  (52); 

PUT  ( F_STRING ) ; 

INTO  (  V_COMMISSION  ) ; 

F_FLOAT  :=  FLOAT  (  V_COMMISSION  ); 

FLOAT_TO_STRING  ( F_FLOAT ,  F_STRING ) ; 

SET_COL  ( 64 ) ; 

PUT  (F_STRING); 
end  loop; 
exception 

when  NOT_FOUND_ERROR  =>  null; 
end; 


CLOSE  (  CURSOR  ); 


—  038  from  page  6-30 


TELL_NUM  (" 038 6-30 select  dept  avg  (salary)  from  emp  group  by  "  & 
"dept  having  avg  (salary)  >  2000.00"); 

DECLAR  (  CURSOR  ,  CURSOR_FOR  => 

SELEC  (  DEPT  &  AVG  (  SALARY  ) , 

FROM  =  >  EMP , 

CROUP J3Y  =>  DEPT, 

HAVING  =>  AVG  (  SALARY  )  >  2000.0  )  ); 

OPEN  (  CURSOR  ) ; 
begin 

FUT_LINE  ("DEPT  AVG( SALARY )") ; 

loop 


Package  EX_2 


112 


UNCLASSIFIED 


FETCH  (  CURSOR  ); 

INTO  (  V_DEPT  )  ; 

SET_COL  (1); 

PUT  { DEPT_CODE ' IMAGE  ( V_DEPT ) ) ; 

INTO  (  V_S ALARY  ); 

F_FLOAT  :=  FLOAT  (  V_SALARY  ); 
FLOAT_TO_STRING  (F_FLOAT,  F_STRING); 
SET_COL  ( 18 ) ; 

PUT  ( F_STRING ) ; 
end  loop; 
exception 

when  NOT_FOUND_ERROR  =>  null; 
end; 


CLOSE  (  CURSOR  ) ; 


—  039  from  page  6-30 


TELL_NUM_2  ( " 039 " , " 6~3 0 " , 

"select  dept,  count  (*)  from  emp  where  job 
"group  by  dept  having  count  (*)  >  2"); 
DECLAR  (  CURSOR  ,  CURSOR_FOR  => 

SELEC  (  DEPT  S  COUNT ('*'), 

FROM  =>  EMP, 

WHERE  =>  LIKE  (  JOB  ,  "salesman%"  ), 

GROUP_BY  =>  DEPT, 

HAVING  =>  COUNT (' * ' )  >  2  )  ); 

OPEN  (  CURSOR  ) ; 

begin 

PUT_LINE  ( " DEPT  COUNT (*)"); 

loop 

FETCH  (  CURSOR  ) ; 

INTO  (  V_DEPT  ) ; 

SET_COL  ( 1 ) ; 

PUT  ( DEPT_C0DE ' IMAGE  ( V_DEPT ) ) ; 

INTO  (  COUNT_RESULT  ) ; 

SET_COL  (18); 

PUT  ( DATABASE . INTG ' IMAGE  ( COUNT_RESULT ) ) ; 
end  loop; 
exception 

when  NOT_FOUND_ERROR  =>  null; 
end; 


CLOSE  (  CURSOR  ) ; 
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—  040  from  page  6-31 


TELL_NUM_3  ("040", "6-31  ", "select  dept,  avg  (salary),  avg  (commission) 

"avg  (salary  *  0.5  +  100)  from  emp", 

"  where  job  *  ' salesman%'  group  by  dept", 

"  having  avg  (commission)  >=  avg  (salary  *  0.5  +  100)"); 

DECLAR  (  CURSOR  ,  CURSOR_FOR  => 

SELEC  (  DEPT  &  AVG  (  SALARY  )  &  AVG  (  COMMISSION  )  & 

AVG  (  SALARY  *  0.5  +  100.0  ), 

FROM  ->  EMP, 

WHERE  ->  LIKE  (  JOB  ,  "salesman%"  ), 

GROUP_BY  =»>  DEPT, 

HAVING  =>  AVG  (  COMMISSION  )  >=  AVG  (  SALARY  *  0.5  +  100.0  )  )  )  ; 
OPEN  (  CURSOR  ) ; 
begin 

PUTJLINE  ("DEPT  AVG( SALARY)  AVG ( COMMISSION)  "  & 

"AVG( (SALARY*. 5) +100) " ) ; 

loop 

FETCH  (  CURSOR  ) ; 

INTO  (  V_DEPT  ) ; 

SET_COL  (1); 

PUT  (DEPT_CODE' IMAGE  (V_DEPT)); 

INTO  (  V_SALARY  ); 

F_FLOAT  : =  FLOAT  (  V_SALARY  ) ; 

FLOAT_TO_STRING  ( F_FLOAT ,  F_STRING ) ; 

SET_COL  (14); 

PUT  (F_STRING); 

INTO  (  V_COMMISSION  ) ; 

F_FLOAT  :=  FLOAT  (  V_COMMISSION  ); 

FLOAT_TO_STRING  ( F_FLOAT,  F_STRING ) ; 

SET_COL  (32); 

PUT  ( F_STF  TNG ) ; 

INTO  (  V_MINIMUM_COMMISSION  )  ; 

F_FLOAT  :=  FLOAT  (  V_MINIMUM_COMMISSION) ; 

FLOAT_TO_STRING  ( F_FLOAT ,  F_STRING ) ; 

SET_COL  (53); 

PUT  ( F_STRING ) ; 
end  loop; 
exception 

when  NOT_FOUND_ERROR  =>  null; 
end; 

CLOSE  (  CURSOR  ) ; 


—  041  from  page  6-31 
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TELL_NUM_2  ("041  ","6-31  ", 

"select  dept,  avg  (salary)  from  emp  group  by  dept  having  avg  (salary)  <’ 
"  select  avg  (salary)  from  emp"); 

DECLAR  (  CURSOR  ,  CURS0R_F0R  => 

SELEC  (  DEPT  &  AVG  (  SALARY  ), 

FROM  ->  EMP, 

GR0UP_BY  =>  DEPT, 

HAVING  =■>  AVG  (  SALARY  )  < 

SELEC  (  AVG  (  SALARY  ) , 

FROM  =>  EMP  )  )  ); 

OPEN  (  CURSOR  )  ; 

begin 

PUT_LINE  ( " DEPT  AVG ( SALARY )  "  )  ; 

loop 

FETCH  (  CURSOR  ) ; 

INTO  (  VJ3EPT  ) ; 

SET_COL  ( 1 )  ; 

PUT  (DEPT_CODE' IMAGE  (V_DEPT)); 

INTO  (  V_SALARY  ) ; 

F_FLOAT  : -  FLOAT  (  V_SALARY  ) ; 

FLOAT_TO_STRING  (F_FLOAT,  F_STRING); 

SET_COL  (18); 

PUT  ( F_STRING ) ; 
end  loop; 
exception 

when  NOT_FOUND_ERROR  =>  null; 
end; 

CLOSE  (  CURSOR  ) ; 


042  from  page  6-32 

example  on  page  6-32  is  not  legal  ANSI  SQL 
select  Name,  Job,  Salary 
from  emp 
where  Dept_No  = 
select  Dept_No 
from  emp 
group  by  Dept_No 
having  avg( Salary)  = 

select  max( avg( Salary ) ) 

from  emp 

group  by  Dept_No  / 


—  cannot  nest  set  functions 
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TELL_NUM_3  (" 042 6-32 ", "select  name,  job,  salary  from  emp  where  dept  =  ", 

"  select  dept  from  emp  group  by  dept  having  avg  (salary)  =  ", 

"  select  max  (avg  (Salary))  from  emp  group  by  dept"); 

PUT_LINE  ("This  example  is  not  legal  ANSI  SQL  —  cannot  nest  set  functions"); 
PUT_LINE  ("This  example  is  not  executed  here"); 


—  043  from  page  6-34 


TELL_NUM  ( "043" , "6-34 ", "select  emp, name,  location  from  emp,  dept"); 

DECLAR  (  CURSOR  ,  CURS0R_F0R  => 

SELEC  (  EMP. NAME  &  LOCATION, 

FROM  =>  EMP  &  DEPT  )  ); 

OPEN  (  CURSOR  ) ; 


begin 

PUT_LINE  ( "EMP_NAME  LOCATION"); 

loop 

FETCH  (  CURSOR  ) ; 

INTO  (  V_EMP_NAME  ,  STR_LAST  ) ; 

T_LEN  :=  INTEGER  ( STR_LAST  -  V_EMP_NAME ' FIRST  +1); 
for  I  in  1. . T_LEN  loop 

T_STRING  (I)  : =  CHARACTER  (V_EMP_NAME  ( V_EMP_NAME ' FIRST  +  I  -  1)); 

end  loop; 

SET_COL  ( 1 ) ; 

FUT  (T_STRING  (l..T_LEN)); 

INTO  (  V_LOCATION  ,  L0CATI0N_LAST  ) ; 

T_LEN  :=  INTEGER  ( LOCATION_LAST  -  V_LOCATION ' FIRST  +  1); 
for  I  in  1 . ,T_LEN  loop 

DLI  : =  DEPT_LOC_INDEX  ( I )  ; 

T_STRING  (I)  :=  CHARACTER  (V_LOCATION  ( V_L0CATI0N ' FIRST  +  DLI  -  1)) 

end  loop; 

SET_C0L  (18) ; 

PUT  (T_STRING  (l..T_LEN)); 
end  loop; 
exception 

when  N0T_F0UND_ERR0R  =>  null; 
end; 

CLOSE  (  CURSOR  ) ; 


—  044  from  page  6-35 

—  example  on  page  6-35  is  not  legal  ANSI  SQL  —  table . *  notation  is  not 

provided  in  ANSI  SQL 

—  select  emp. Name,  dept.* 
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—  from  emp,  dept 

—  where  Dept_No  =  dept. Number  / 

TELL_NUM  ( "044 ", "6-35" , "select  emp. name,  dept.*  from  emp,  "  & 

"dept  where  dept  -  dept. number" ) ; 

PUT_LINE  ("This  example  is  not  legal  ANSI  SQL  —  table.*  notation  is  not") 
PUT_LINE  ("provided  in  ANSI  SQL" ) ; 

PUT_LINE  ("This  example  is  not  executed  here"),- 


—  045  from  page  6-36 


TELL_NUM_2  (" 045 "," 6-36 " , 

"select  name,  salary  *  12,  min_amount ,  max_amount  from  emp,  taxes", 

"  where  salary  *  12  between  min_amount  and  max_amount" ) ; 

DECLAR  (  CURSOR  ,  CURS0R_F0R  => 

SELEC  (  NAME  &  C0NVERT_T0 . EXAMPLEJTYPES . ANNUALJPAY  (  SALARY  *  12.0  )  S 
MIN_AMOUNT  &  MAX_AMOUNT,  —  see  previous  comments  on  type 
FROM  =>  EMP  &  TAXES,  —  conversions 

WHERE  =>  BETWEEN 

(  C0NVERT_T0 . EXAMPLEJTYPES . ANNUAL_PAY  (  SALARY  *  12.0  ), 
MIN_AMOUNT  and  MAX_AMOUNT  )  )  ) ; 

OPEN  (  CURSOR  ) ; 

begin 

PUT_LINE  ( "EMP_NAME  ANNUAL_PAY  MIN_AMOUNT  MAX_AMOUNT " ) ; 

loop 

FETCH  (  CURSOR  ) ; 

INTO  (  V_EMP_NAME  ,  STR_LAST  ) ; 

T_LEN  :=  INTEGER  ( STR_LAST  -  V_EMP_NAME' FIRST  +  1); 
for  I  in  1 . . T_LEN  loop 

T_STRING  (I)  :=  CHARACTER  (V_EMP_NAME  ( V_EMP_NAME ' FIRST  +  I  -  1)); 

end  loop; 

SET_COL  ( 1 ) ; 

PUT  ( T_STRING  ( 1 . . T_LEN ) ) ; 

INTO  (  V_ANNUAL_PAY  ) ; 

F_FL0AT  :=  FLOAT  (  V_ANNUAL_PAY ) ; 

FLOAT_TO_STRING  (FFLOAT,  F_STRING) ; 

SET_COL  (18); 

PUT  ( F_STRING ) ; 

INTO  (  V_MIN_AMOUNT  ) ; 

F_FL0AT  : =  FLOAT  (  V_MIN_AMOUNT  ) ; 

FLOAT_TO_STRIHG  (F_FLOAT,  F_STRING) ; 

SET_COL  (30); 

PUT  ( F_STRING)  ; 

INTO  (  V_MAX_AMOUNT  ) ; 

F_FLOAT  :=  FLOAT  (  V _MAX_AMOUNT ) ; 
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FLOATJTO_STRING  (F_FLOAT,  F_STRING) ; 
SET_COL  (42); 

PUT  ( F_STRING ) ; 
end  loop; 
exception 

when  NOT_FOUND_ERROR  =>  null; 
end; 


CLOSE  (  CURSOR  ); 


—  046  from  page  6-37 

—  here  is  another  example  of  a  computation  that  becomes  laborious  with 

—  strong  typing.  But,  any  Ada  program  applying  typing,  whether  going  to  a 

—  database  or  not,  will  have  to  perform  the  same  type  conversions  to  keep 

—  the  types  meaningful 


TELL_NUM_5  ( "046" , "6-37" , 

"select  emp.name,  location,  salary  *  12  +  commission,  ", 

"  base_tax  +  (((salary  *  12)  +Wcommission )  -  min_amount)  *  "  & 

"marginal_rate" , 

"  from  emp,  taxes,  dept  ", 

"  where  (salary  *  12)  +  commission  between  min_amount  "  & 

"and  maxamount" , 

"  and  dept  =  dept .number"); 


DECLAR  ( 
SELEC 


CURSOR  ,  CURSOR  FOR  => 


( 


FROM  => 
WHERE  => 


AND 


EMP.NAME  &  LOCATION  & 

CONVERT_TO . EXAMPLEJTYPES . ANNUAL_PAY  —  see  previous  comments 
(  SALARY  *  12.0  +  COMMISSION  )  &  —  about  type  conversions 

(  BASEJTAX  + 

CONVERT  JTO . EXAMPLEJTYPES . TAX_AMOUNT 

(  CONVERT_TO . EXAMPLEJTYPES . TAX_COMPUTATION_PRECISION 
(  CONVERT  JTO . EXAMPLEJTYPES . ANNUAL_PAY 

(  SALARY  *  12.0  +  COMMISSION  )  -  MIN_AMOUNT  )  * 

CONVERT  JTO . EXAMPLEJTYPES . TAX_COMPUTATION_PRECISION 
(  MARGINAL_RATE  )  )  ) , 

EMP  &  TAXES  &  DEPT,  —  qualification  of  CODE  on 

BETWEEN  —  last  line  is  not 

(  CONVERTJTO . EXAMPLEJTYPES . ANNUAL_PAY  —  required  since  we 
(  SALARY  *  12.0  +  COMMISSION  ), 

M I N_ AMOUNT  and  MAX_ AMOUNT  ) 

EQ  (  DEPT  ,  DEPT . CODE  )  )  ) ; 


changed  the  column 
name,  but  is  retained 
to  track  example 


OPEN  (  CURSOR  )  ; 


begin 

PUT_LINE  ( 

" EMP  JNAME  LOCATION  ( SALARY* 1 2 ) +COMMISSION  TAX_AMOUNT " ) ; 
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loop 

FETCH  (  CURSOR  ) ; 

INTO  {  V_EMP_NAME  ,  STR_LAST  ) ; 

T_LEN  INTEGER  ( STR_LAST  -  V_EMP_NAME' FIRST  +  1); 
for  I  in  1. . T_LEN  loop 

T_STRING  (I)  :=  CHARACTER  (V_EMP_NAME  (V_EMP_NAME' FIRST  +  I  -  1)); 

end  loop; 

SET_COL  (1); 

PUT  (T_STRING  (l..T_LEN)); 

INTO  (  V_LOCATION  ,  LOCATION_LAST  ); 

T_LEN  :=  INTEGER  (LOCATION_LAST  -  V_LOCATION' FIRST  +  1); 
for  I  in  1 . . T_LEN  loop 

DLI  :=  DEPT_LOC_INDEX  ( I )  ; 

T_STRING  (I)  :=  CHARACTER  <V_LOCATION  (V_LOCATION' FIRST  +  DLI  -  1)); 

end  loop; 

SET_COL  (18); 

PUT  ( T_STRING  ( 1 . . T_LEN ) ) ; 

INTO  (  V_ANNUAL_PAY  ) ; 

F_FLOAT  :=  FLOAT  (  V_ANNUAL_PAY ) ; 

FLOAT_TO_STRING  ( F_FLOAT ,  F_STRING) ; 

SET_COL  (42); 

PUT  (F_STRING); 

INTO  (  V_BASE_TAX  ) ; 

F_FLOAT  :=  FLOAT  (  V_BASE_TAX) ; 

FLOAT_TO_STRING  ( F_FLOAT ,  F_STRING) ; 

SET_COL  (59); 

PUT  (F_STRING); 
end  loop; 
exception 

when  NOT_FOUND_ERROR  =>  null; 
end; 

CLOSE  (  CURSOR  ) ; 


—  047  from  page  6-38 


TELL_NUM_2  (  " 04 7 " , " 6-3 8 " , 

"select  emp.name,  emp. salary,  mgr. name,  mgr. salary  from  emp,  mgr.emp" 
"where  emp. salary  >=  mgr. salary  and  emp. manager  =  mgr . number ") ; 

DECLAR  (  CURSOR  ,  CURSOR_FOR  => 

SELEC  (  EMP.NAME  &  EMP . SALARY  S  MGR . NAME  &  MGR. SALARY, 

FROM  =>  EMP  &  MGR.EMP, 

WHERE  =>  EMP. SALARY  >=  MGR . SALARY 

AND  EQ  (  EMP . MANAGER  ,  MGR . NUMBER  )  )  ) ; 

OPEN  (  CURSOR  ) ; 


w; 

Kl 

Vi* 

sT 

EU 
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begin 

PUT_LINE  ( "EMP_NAME 
loop 

FETCH  (  CURSOR  ) ; 
INTO  (  V_EMP_NAME 


SALARY  MGR  NAME 


MGR_SALARY" )  ; 


STR_LAST  ) ; 

T_LEN  :=  INTEGER  ( STR_LAST  -  V_EMP_NAME ' FIRST  +  1); 
for  I  in  1. . T_LEN  loop 

T_STRING  (I)  :=  CHARACTER  ( V_EMP_NAME  (V_EMP_NAME' FIRST  +  I 

end  loop; 

SET_COL  (1); 

PUT  { T_STRING  ( 1 . . T_LEN ) ) ; 

INTO  (  V_SALARY  ) ; 

F_FLOAT  : =  FLOAT  (  V_SALARY  ) ; 

FLOAT_TO_STRING  ( F_FLOAT ,  F_STRING); 

SET_COL  (13); 

PUT  (F_STRING); 

INTO  (  V_MGR_NAME  ,  STR_LAST_2  ) ; 

T_LEN  :=  INTEGER  (STR_LAST_2  -  V_MGR_NAME ' FIRST  +  1); 
for  I  in  1. . T_LEN  loop 

T_STRING  (I)  :=  CHARACTER  (V_MGR_NAME 
(V_MGR_NAME' FIRST  +  I  -  1)); 
end  loop; 

SET_COL  (30); 

PUT  ( T_STRING  ( 1 . . T_LEN ) ) ; 

INTO  (  V_MGR_SALARY  ) ; 

F_FLOAT  : =  FLOAT  (  V_MGR_SALARY  ) ; 

FLOAT_TO_STRING  (F_FLOAT,  F_STRING) ; 

SET_COL  (47); 

PUT  ( F_STRING) ; 
end  loop; 
exception 

when  NOT_FOUND_ERROR  =>  null; 
end; 


i)); 


CLOSE  (  CURSOR  ) ; 


—  048  from  page  6-38 


TELL_NUM_4  (  "  04 8 " , " 6-3 8 " , 

"select  emp. name,  dept . location ,  mgr. name,  mgr_dept . location" , 

"from  emp,  dept,  mgr. emp,  mgr_dept . dept  where  emp. manager  =  mgr. number", 
"and  emp. dept  =  dept . code  and  mgr. dept  =  mgr_dept . code " , 

"and  ~=  dept .  location  =  mgr_dept .  location"  )  ,- 


DECLAR  (  CURSOR  ,  CURSOR_FOR  => 

SELEC  (  EMP. NAME  S  DEPT . LOCATION  &  MGR . NAME  &  MGR_DEPT . LOCATION , 
FROM  =>  EMP  &  DEPT  &  MGR. EMP  &  MGR_DEPT . DEPT , 

WHERE  =>  EQ  (  EMP. MANAGER  ,  MGR . NUMBER  ) 
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MGR  NAME 


MGR_LOCATION" ) ; 


AND  EQ  (  EMP.DEPT  ,  DEPT . CODE  ) 

AND  EQ  (  MGR. DEPT  ,  MGR_DEPT . CODE  ) 

AND  NE  (  DEPT . LOCATION  ,  MGR_DEPT . LOCATION  )  )  ) ; 

OPEN  (  CURSOR  ) ; 

begin 

PUTJLINE  ("EMP_NAME  LOCATION  MGR_NAME  MGR_LOCATION 

loop 

FETCH  (  CURSOR  ); 

INTO  (  V_EMP_NAME  ,  STR_LAST  ); 

T_LEN  :=  INTEGER  ( STR_LAST  -  V_EMP_NAME' FIRST  +  1); 
for  I  in  1 . . T_LEN  loop 

T_STRING  (I)  :  =  CHARACTER  (V_EMP_NAME  ( V_EMP_NAI-IE '  FIRST  +  I  -  1)); 
end  loop; 

SET_COL  ( 1 )  ; 

PUT  ( T_STRING  ( 1 . . T_LEN ) ) ; 

INTO  (  V_LOC AT ION  ,  LOCATION_LAST  ); 

T_LEN  :=  INTEGER  ( LOCATION_LAST  -  V_LOCATION' FIRST  +  1)  ; 
for  I  in  1. . T_LEN  loop 

DLI  : =  DEPT_LOC_INDEX  ( I )  ; 

T_STRING  (I)  : =  CHARACTER  (V_LOCATION  ( V_LOCATION' FIRST  +  DLI  -  1)); 

end  loop; 

SET_COL  (18); 

PUT  ( T_STRING  ( 1 . . T_LEN ) ) ; 

INTO  (  V_MGR_NAME  ,  STR_LAST_2  ); 

T_LEN  :=  INTEGER  ( STR_LAST_2  -  V_MGR_NAME ' FIRST  +1); 
for  I  in  1. . T_LEN  loop 

T_STRING  (I)  :=  CHARACTER  ( V_MGR_NAME 
(V_MGR_NAME' FIRST  +  I  -  1)); 
end  loop; 

SET_COL  (35); 

PUT  ( T_STRING  ( 1 . . T_LEN ) ) ; 

INTO  (  V_MGR_LOCAT ION  ,  LOCATION_LAST_2  ); 

T_LEN  :=  INTEGER  ( L0CATI0N_LAST_2  -  V_MGR_LOCATION' FIRST  +1); 
for  I  in  1 . . T_LEN  loop 

DLI  : =  DEPT_LOC_INDEX  ( I ) ; 

T_STRING  (I)  :=  CHARACTER  ( V_MGR_LOCATION 

( V_MGR_LOCATION' FIRST  +  DLI  -  1)); 

end  loop ; 

SET_COL  (52); 

PUT  ( T_STRING  ( 1 . . T_LEN ) ) ; 
end  loop; 
exception 

when  NOT_FOUND_ERROR  =>  null; 
end; 

CLOSE  (  CURSOR  )  ; 


121 


Package  EX_2 


UNCLASSIFIED 


—  049  from  page  6-40 

TELL_NUM_5  ( " 04 9" , " 6-4 0 " , 

"select  name,  job,  salary  +  commission  from  x.emp  where  job  is  in", 

"  select  job  from  emp  group  by  job  having  count  (*)  >=  4,", 

"and  salary  +  commission  >  ", 

"  select  sum  (salary  +  commission)  *  0.25  from  emp  "  & 

"where  emp. job  =  x.job", 

"  and  emp. number  ~=  x. number  group  by  job"); 

DECLAR  (  CURSOR  ,  CURSCR_FOR  => 

SELEC  (  NAME  &  JOB  &  (  SALARY  +  COMMISSION  ) , 

FROM  =>  X.EMP, 

WHERE  =>>  IS_IN  (  JOB, 

SELEC  (  JOB , 

FROM  =>  EMP, 

GROUP_BY  =>  JOB, 

HAVING  =>  COUNT ( ' * ' )  >=  4  )  ) 

AND  SALARY  +  COMMISSION  > 

SELEC  (  SUM  (  SALARY  +  COMMISSION  )  *  0.25, 

FROM  =>  EMP, 

WHERE  =>  EQ  (  EMP. JOB  ,  X.JOB  ) 

AND  NE  (  EMP. NUMBER  ,  X. NUMBER  ), 

GROUP_BY  =>  JOB  )  )  )  ; 

OPEN  (  CURSOR  ) ; 

begin 

PUT_LINE  ( "EMP_NAME  JOB  SALARY+COMMISSION" ) ; 

loop 

FETCH  (  CURSOR  ) ; 

INTO  (  V_EMP_NAME  ,  STR_LAST  ) ; 

TJLEN  :  =  INTEGER  ( STR_LAST  -  V_EMP_NAME ' FIRST  +  1); 
for  I  in  1 . . T_LEN  loop 

T_STRING  (I)  :  =  CHARACTER  (V_EMP_NAME  (V_EMP_NAME' FIRST  +  I  -  1 ) ) ; 

end  loop; 

SET_C0L  ( 1 ) ; 

PUT  (T_STRING  (1 . . T_LEN ) ) ; 

INTO  (  V_J0B  ,  JOB_LAST  ) ; 

T_LEN  :=  INTEGER  (J0B_LAST  -  V_JOB ' FIRST  +  1); 

T_STRING  ( 1 . . T_LEN )  :=  STRING  (V_JOB  (V_J0B' FIRST  ..  J0B_LAST ) ) ; 

SET_C0L  (18); 

PUT  (T_STRING  (l..T_LEN)); 

INTO  (  V_SALARY  ) ; 

F_FLOAT  : =  FLOAT  (  V_SALARY  ) ; 

FLOAT_TO_STRING  ( F_FLOAT ,  F_STRING); 

SET_COL  (35); 

PUT  ( F_STRING ) ; 
end  loop; 
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exception 

when  NOT_FOUND_ERROR  »>  null; 
end; 


CLOSE  (  CURSOR  ); 


—  050  from  page  6-41 


TELL_NUM  ("050", "6-41  ",  "insert  into  dept  (number,  name,  location)  "  & 

":  <  COLL,  'Collection',  'Atlanta'  >"); 

IN SERT_INTO  (  DEPT  (  CODE  &  NAME  &  LOCATION  ) , 

VALUES  <=  COLL  and  EXAMPLE_TYPES . ADA_SQL. DEPT_NAME' ( "Collection  ") 

and  EXAMPLE_TYPES . ADA_SQL . DEPT_L OC ' ( "Atlanta " )  )  ; 

-  Note  that  literals  may  require  type  qualification  if  their  type  could  be 
ambiguous.  In  real  programs,  program  variables  would  typically  be  used 
rather  than  literals,  so  type  qualification  would,  in  general,  not  be 
required. 


1 
JR 


—  051  from  page  6-42 

—  example  on  page  6-42  is  not  legal  ANSI  SQL  —  cannot  insert  more  than  one 

—  row  at  a  time 

—  insert  into  emp: 


— 

< 

3000, 

' Owens ' , 

o 

CO 

' clerk' , 

3100, 

950.00, 

0 . 00 

>, 

— 

< 

3100, 

'Clark' , 

o 

00 

'c.p.a. ' , 

2400, 

1800.00, 

0.00 

— 

< 

3200, 

'Williams' , 

o 

00 

'clerk' , 

3100, 

2500.00, 

0.00 

>  / 

TELL_NUM_4  ("051  "," 6-42 "," insert  into  emp:", 

"  <  3000,  'Owens',  COLL,  'clerk',  3100,  950.00,  0.00  >,", 

”  <  3100,  'Clark',  COLL,  'c.p.a.',  2400,  1800.00,  0.00 

"  <  3200,  'Williams',  COLL,  'clerk',  3100,  2500.00,  0.00  >"); 

PUT_LINE  ("This  example  is  not  legal  ANSI  SQL  —  "  S 

"cannot  insert  more  than  one  row  at  a  time"); 

PUT_LINE  ("This  example  is  broken  into  three  examples,  52,  53  &  54"); 


—  052  from  page  6-42 


TELL_NUM_2  (" 052 6-4 2 insert  into  emp:", 

"  <  3000,  'Owens',  COLL,  'clerk',  3100,  950.00,  0.00  > " )  ; 

INSERT_INTO  (  EMP  , 

VALUES  <=  EXAMP LE_TYPES . ADA_SQL . EMP_NUMBER' ( 3000 )  and 

EXAMPLE_TYPES.ADA_SQL.EMP_NAME' ( "Owens  ")  and 
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COLL  and 

EXAMPLEJTYPES . ADA_SQL . EMP_JOB ' { " clerk  " )  and 

EXAMPLE  JTYPES.ADA_SQL.EMP_NUMBER' (3100)  and 
EXAMP LE_T YP E S . ADA_SQL . MONTHLY_PAY '(950.00)  and 
EXAMPLEJTYPES . ADA_SQL . MONTHLY_PAY '(0.00)  ) ; 


J 

$ 

£ 

J 

| 


-  053  from  page  6-42 


TELL_NUM_2  ( "053 " , "6-42" , "insert  into  emp:", 

"  <  3100,  'Clark',  COLL,  'c.p.a.',  2400,  1800.00,  0.00  >"), 


INSERT_INTO  (  EMP, 

VALUES  <=  EXAMPLE_TYPES.ADA_SQL.EMP_NUMBER' (3100)  and 

EXAMPLE_TYPES . ADA_SQL . EMP_NAME ' ( "Clark  ” )  and 

COLL  and 

EXAMPLE_TYPES . ADA_SQL . EMP— JOB ' ("c.p.a.  ")  and 

EXAMPLEJTYPES . ADA_SQL . EMP_NUMBER ' ( 2400 )  and 
EXAMPLE_TYPES . ADA_SQL . MONTHL Y_P A Y ' (1800.00)  and 
EXAMPLEJTYPES . ADA_SQL . MONTHLY_PAY '(0.00)  ) ; 


—  054  from  page  6-42 


TELL_NUM_2  ( "054" , "6-42" , "insert  into  emp:", 

"  <  3200,  'Williams',  COLL,  'clerk',  3100,  2500.00,  0.00  > " ) ; 


> 


'A 


INSERT_INTO  (  EMP, 

VALUES  <=  EXAMPLE_TYPES.ADA_SQL.EMP_NUMBER' (3200)  and 

EXAMPLEJTYPES . ADA_SQL . EMP_NAME ' ( "Williams  " )  and 
COLL  and 

EXAMPLEJTYPES . ADA_SQL . EMP_J0B ' ( " clerk .  ")  and 

EXAMPLEJTYPES . ADA_SQL . EMP_NUMBER ' ( 3100 )  and 
EXAMPLE_TYPES . ADA_SQL . MONTHLY_PAY ' (2500.00)  and 
EXAMPLEJTYPES . ADA_SQL . MONTHLY_PAY '(0.00)  ) ; 


—  055  from  page  6-42 


TELL_NUM_2  (" 055 6-4 2 insert  into  candidates:", 

"  select  number,  name,  dept,  salary  from  emp  where  "  & 
"commission  >  0.5  *  salary"); 


£ 

S 


INSERT_INTO  (  CAND, 

SELEC  (  NUMBER  S  NAME  &  DEPT  &  SALARY, 
FROM  =>  EX , 

WHERE  =>  COMMISSION  >  0.5  *  SALARY  )  ); 
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■  056  from  page  6-43 


TELL_NUM  ("056 ","6-43", 

"update  emp  set  salary  =  1000  where  name  =  'Owens - 

UPDATE  (  EMP,  —  cannot  use  "Owens*"  for  Ada 

SET  =>  SALARY  <=  1000.0,  —  reasons  —  we  made  EMP_NAME 

WHERE  =>  LIKE  (  NAME  ,  "Owens _ "  )  ) ;  —  constrained  to  be  illustrative 


057  from  page  6-43 


TELL_NUM  ( "057" , "6-43" , "update  emp  set  commission  =  salary  *  0.35,  "  & 
"DEPT  «  FIN  where  job  =  ' salesman% ' " ) ; 

UPDATE  (  EMP, 

SET  =>  COMMISSION  <=  SALARY  *  0.35 
and  DEPT  <=  FIN, 

WHERE  =>  LIKE  (  JOB  ,  "salesman*"  )  ); 


058  from  page  6-43 

example  on  page  6-43  is  not  legal  ANSI  SQL  —  cannot  use  subquery  to 
produce  values  for  update 
update  emp 
set  Commission  = 

select  Base_Tax  +  ((Salary  *  12)  -  Min_Amount)  *  Marginal_Rate 
from  emp  x,  taxes 

where  Salary* 12  between  Min_Amount  and  Max_Amount 
and  emp . Number  =  x. Number; 
where  Dept_No  =  70  / 

TELL_NUM_4  (" 058 "," 6-4 3 ", "update  emp  set  commission  =", 

"select  base_tax  +  ((salary  *  12)  -  min_amount)  *  marginal_rate" , 

"from  x.emp,  taxes  where  salary  *  12  between  min_amount  and  max_amount" , 
"and  emp.  number  =  x.  number;  where  dept  =  FIN"),- 
PUT_LINE  ( "This . example  is  not  legal  ANSI  SQL  —  cannot  use  "  & 

"subquery  to  produce"); 

PUT_LINE  ("values  for  update"); 

PUT_LINE  ("This  example  is  not  executed  here"); 


■  059  from  page  6-44 


TELL_NUM  ( "059" , "6-44" , "delete  emp  where  name  =  'Owens _ '"); 
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_"  )  );  —  see  above  comment  on  "Owens*" 


DELETE_FROM  (  EMP, 

WHERE  »>  LIKE  (  NAME  ,  "Owens_ 


—  060  from  page  6-44 


TELL__NUM  ( "060" , "6-44" , "delete  emp  where  dept  =  select  code  from  "  & 
"dept  where  location  =  ' Atlanta* '") ; 

DELETE_FROM  (  EMP, 

WHERE  ->  EQ  (  DEPT, 

SELEC  (  CODE, 

FROM  =>  DEPT, 

WHERE  ->  LIKE  (  LOCATION  ,  "Atlanta*"  )  )  )  ); 
end  EXAMPLE_2; 
end  EX  2; 


15.  Procedure  EXAMPLE 


with  TEXT_IO,  SYSTEM,  EXAMPLE_TYPES ,  EXAMPLE_VARIABLES ,  EX_1 ,  EX_2; 
use  TEXT_I0 ,  SYSTEM,  EXAMPLE_TYPES ,  EXAMPLE_VARIABLES ,  EX_1 ,  EX_2 ; 

procedure  EXAMPLE  is 

use  EXAMPLE_TYPES . ADA_SQL ; 

subtype  ADDRESS  is  SYSTEM. ADDRESS; 
procedure  CSYSTEM  ( STR  :  ADDRESS); 
pragma  Interface  (C,  CSYSTEM); 

TMP  :  STRING ( 1. . 62)  := 

"sh  /div/brykczynski/f ill . exdb  >/div/brykczynski/f ill . out  2>&1  "  & 
ascii . nul; 


begin 

V_NUMBER 

V_EMP_NAME 

V_DEPT 

V_JOB 

V_MANAGER 

V_SALARY 

V_MAX_S ALARY 

V_COMMISSION 

V_MINIMUM_COMMISSION 

V_DEPT_NAME 

V  LOCATION 


=  ADMIN  ; 

_  II 

=  1  ; 

=  0.0  ; 

=  0.0  ; 

=  0.0  ; 

=  0.0  ; 


Procedure  EXAMPLE 


KIT* 


UNCLASSIFIED 


V_MIN_AMOUNT 

V_MAX_AMOUNT 

V_BASE_TAX 

V_EXT  RA_T  AX 

V_ANNUAL_PAY 

V_MARGINAL_RATE 

V_TOTAL_PAY 

VJMGR_NAM£ 

V_MGR_S ALARY 

V_MGR_LOCAT ION 

COUNT_RESULT 

STR_LAST 

STR_LAST_2 

JOB_LAST 

LOCATION_LAST 

LOCATION  LAST  2 


PUT_LINE  ("This  Ada/SQL  application  program  executes  the  "  & 
"database  functions  shown  in  the"); 

PUT_LINE  ("examples  in  the  Unify  Reference  Manual,  Section  6  "  S 
"'SQL  -  Query/DML  Language'."); 

PUT_LINE  ( "The  Unify  database  used  must  be  filled  with  the  "  & 
"correct  data  when  this  program"); 

PUT_LINE  ("begins  to  execute.  To  prime  the  database  we  will  now  "  I 
"run  the  command  file  "); 

PUT_LINE  ("/div/brykczynski/fill.exdb.  Output  will  go  to  "  & 
"/div/brykczynski/f ill . out . " ) ; 

PUT_LINE  ("You  don't  need  to  check  this  file  unless  you  want  to."); 

PUT_LINE  ("  "); 

CSYSTEM  ( TMP ' ADDRESS ) ; 

PUT_LINE  ( "This  example  uses  four  database  tables  "  S 
"EMP,  DEPT,  TAXES  and  CAND  from  the  Unify"); 

PUT_LINE  ("database.  Below  is  a  list  of  the  names  used  "  & 

"to  reference  the  fields  in  the"); 

PUT_LINE  ("Ada/SQL  program  and  the  Unify  manual."); 

PUT_LINE  ( "  " ) ; 


PUT_LINE  ( "  " )  ; 
PUT_LINE  ("table:  EMP 
PUT_LINE  (" 

PUT_LINE  ( " 

PUT_LINE  ' " 

PUT_LINE  (" 

PUT_LINE  (" 

PUT_LINE  (" 

PUT_LINE  ( " 

PUT_LINE  ( "  " )  ; 
PUT_LINE  ("table:  DEPT 
PUT_LINE  (" 

PUT_LINE  (" 


Ada/SQL 

NUMBER 


JOB 

MANAGER 

SALARY 

COMMISSION 

Ada/SQL 

CODE 


Unify" ) ; 
NUMBER" ) ; 
NAME" ) ; 
DEPT_NO" ) ; 

JOB " ) ; 
MANAGER" )  ; 
SALARY" ) ; 
COMMISSION" ) ; 

Unify" ) ; 
NUMBER" ) ; 
NAME" )  ; 
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PUT_LINE 

p 

LOCATION 

LOCATION" ) ; 

PUT_LINE 

P  "); 

PUT_LINE 

("table: 

TAXES 

Ada/SQL 

Unify" ) ; 

PUT_LINE 

P 

MIN_AMOUNT 

MIN_AM0UNT " ) ; 

PUT_LINE 

P 

MAX_AMOUNT 

MAX_AMOUNT " ) ; 

PUT_LINE 

P 

BASE_TAX 

BASE_TAX" ) ; 

PUT_LINE 

P 

MARGINAL_RATE  MARGINAL_RATE" ) ; 

PUT_LINE 

P  "); 

PUT_LINE 

( "table : 

CAND 

Ada/SQL 

Unify" ) ; 

PUT_LINE 

P 

NUMBER 

NUMBER" ) ; 

PUT_LINE 

P 

NAME 

NAME" ) ; 

PUT_LINE 

P 

DEPT 

DEPT_N0" ) ; 

PUT_LINE 

P 

SALARY 

SALARY" ) ; 

PUT_LINE 

P  ”); 

PUT_LINE 

P  "); 

PUT_LINE 

("All  of 

the  data  types  in 

these  tables  are  the 

"same  except  for  DEPT  of  EMP,"); 

PUT_LINE  ("CODE  of  DEPT  and  DEPT  of  CAND,  which  all  refer  to  "  & 
"the  department  field.  The"); 

PUT_LINE  ("Unify  manual  treats  these  columns  as  numeric  with  "  & 
"values  10,  20,  30,  40,  50,"); 

PUT_LINE  ("60,  70  and  80.  The  database  we're  using  defines  a  "  & 
"numeric  field  with  the"); 

PUT_LINE  ("values  of  1,  2,  3,  4,  5,  6,  7  and  8.  The  Ada/SQL  "  & 
"example  program  treats  these"); 

PUT_LINE  ("fields  as  an  enumeration  type  where  1  =  ADMIN,  "  & 

"2  =*  ESALES,  3  =  CSALES,  4  -"); 

PUT_LINE  ("WSALES,  5  =  MKTING,  6  =  RSRCH,  7  =  FIN,  and  8  =  COLL"); 

PUT_LINE  (’’  "  )  ; 

EXAMPLE_1 ; 

EXAMPLE_2 ; 
end  EXAMPLE; 


16.  Sample  Data 

This  portion  of  the  software  contains  two  sets  of  SQL,  each  of  which  will  be  invoked  by  the 
Ada/SQL  system.  The  DELETE’s  will  be  invoked  to  clear  out  any  data  which  may  have  been  left  in 
the  UNIFY  database  due  to  a  prior  execution,  the  FILL’S  will  bulk  load  the  database  with  the  data 
which  will  be  used  in  the  demonstration  of  the  Ada/SQL  system. 

delete  CAND  where  NUMBER  <  9999  / 
delete  customer  where  Customer_Number  <  9  / 
delete  DEPT  where  CODE  <  9999  / 
delete  EMP  where  NUMBER  <  9999  / 
delete  item  where  Ser ial_Number  <  9999  / 
delete  manf  where  Manuf acturer_ID  <  999  / 
delete  model  where  Model_Number  <  99999  / 
delete  TAXES  where  MARGINAL_RATE  <  9.999  / 
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tCn-CvC' 


V 


Yf  1 


s  ^  ywjr* 


UNCLASSIFIED 


► 


► 


file  FILL. ALL 

SQL  del . taxes 
SQL  del . emp 
SQL  del . dept 
SQL  del . cand 
SQL  fill. dept 
SQL  fill. emp 
SQL  fill. taxes 
SQL  del . taxes 
SQL  del . emp 
SQL  del . dept 
SQL  del . cand 
SQL  fill. dept 
SQL  fill. emp 
SQL  fill. taxes 

file  FILL. CAN 

insert  into  CAND: 

<  1900,  'Brown', 
insert  into  CAND: 

<  2800 ,  ' Fiorella' , 
insert  into  CAND: 

<  1800,  'Amato', 
insert  into  CAND: 

<  2700,  'Colucci', 
insert  into  CAND: 

<  1700,  'Moehr' , 
insert  into  CAND: 

<  2600,  ' Bleriot' , 
insert  into  CAND: 

<  1600,  'Dupre', 
insert  into  CAND: 

<  2500,  'Kawasaki', 
insert  into  CAND: 

<  1500,  'Otsak.-  , 
insert  into  CAjnO: 

<  2400,  'Lee', 
insert  into  CAND: 

<  1400,  ' Scharf ' , 
insert  into  CAND: 

<  2300,  'Klein', 
insert  into  CAND: 

<  1300,  'Schmidt', 
insert  into  CAND: 

<  2200,  'Dugan' , 
insert  into  CAND: 

<  1200,  '0"Neil' , 


60, 

2000 

.  00 

>  / 

70, 

800. 

oo  : 

-  / 

40, 

2000 

.  00 

>  / 

40, 

2500 

.00 

>  / 

70, 

950. 

00 

>  / 

10, 

1100 

.  00 

>  / 

50, 

800  . 

00 

>  / 

30, 

1800 

.  00 

>  / 

60, 

1800 

.  00 

>  / 

10, 

7500 

.  00 

>  / 

10, 

800  . 

00 

>  / 

20, 

1500 

.  00 

>  / 

60, 

2500 

.  00 

>  / 

40, 

1650 

.  00 

>  / 

20, 

1500. 

00 

>  / 

Lie 
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Sample  Data 


%*  *0  v  •  ■  *  V*  v*  s’  .-I  v*  • 


UNCLASSIFIED 


insert  into  CAND: 

<  2100,  'Reilly',  30,  2500.00  >  / 
insert  into  CAND: 

<  1100,  'Whittaker',  20,  2500.00  >  / 

insert  into  CAND: 

<  2000,  'Jones',  10,  900.00  >  / 

insert  into  CAND: 

<  1000,  'Smith',  50,  1500.00  >  / 

file  FILL. CUS 

insert  into  customer: 

<  3,  'Reliable  Construction  Co.',  '2113  Folsom  Blvd.',  'Sacramento 
insert  into  customer: 

<  2,  'Creative  manufacturing',  '9124  Industrial  Blvd.',  'Redding', 
insert  into  customer: 

<  1,  'Smith  6  Sons  Hardware',  '1234  State  Street',  'Wheatville' ,  ' 
file  FILL . DEP 

insert  into  DEPT: 

<  7,  'Finance',  'Dallas'  >  / 

insert  into  DEPT: 

<  6,  'Research',  'Dallas'  >  / 

insert  into  DEPT: 

<  5,  'Marketing',  'San  Francisco'  >  / 

insert  into  DEPT: 

<  4,  'Western  Sales',  'Los  Angeles'  >  / 
insert  into  DEPT: 

<  3,  'Central  Sales',  'Chicago'  >  / 
insert  into  DEPT: 

<  2,  'Eastern  Sales',  'New  York'  >  / 
insert  into  DEPT: 

<  1,  'Administration',  'Dallas'  >  / 
file  FILL . EMP 


insert  into  EMP: 

<  1900,  'Brown' , 
insert  into  EMP: 

<  2800,  'Fiorella', 
insert  into  EMP: 

<  1800,  'Amato', 
insert  into  EMP: 

<  2700,  'Colucci' , 
insert  into  EMP: 

<  17  00 ,  ' Moehr ' , 
insert  into  EMP: 

<  2600 ,  ' Bleriot ' , 
insert  into  EMP: 


6, 

' engineer' , 

1300 

7, 

' clerk ' , 

1700 

4, 

' salesman' , 

2200 

4, 

' salesman ' , 

2200 

7, 

' clerk' , 

2400 

1, 

' programmer' , 

1300 

2000 . 00,  0 . 00  >  / 
800.00,  0.00  >  / 
2000. 00,  750. 00  >  / 

2500.00,  3000.00  >  / 
950 . 00,  0 . 00  >  / 

1100. 00,  0. 00  >  / 
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> 

UNCLASSIFIED 


1 

<  1600,  'Dupre', 

5, 

'clerk' , 

1000, 

800.00, 

0.00 

> 

/ 

insert  into  EMP : 

<  2500,  'Kawasaki', 

3, 

' salesman' , 

2100, 

1800.00, 

1000.00 

> 

/ 

insert  into  EMP: 

<  1500,  'Otsaka', 

6, 

'engineer' , 

1300, 

1800.00, 

0.00 

> 

/ 

1 

insert  into  EMP: 

<  2400,  'Lee', 

1# 

'president' , 

2400, 

7500.00, 

0.00 

> 

/ 

) 

insert  into  EMP : 

<  1400,  'Scharf', 

1, 

'clerk' , 

2000, 

800 . 00, 

0.00 

> 

/ 

insert  into  EMP: 

<  2300,  'Klein', 

2, 

' salesman' , 

1100, 

1500 . 00, 

0.00 

> 

/ 

» 

insert  into  EMP: 

<  1300,  'Schmidt', 

6, 

'programmer' , 

2400, 

2500 . 00, 

0.00 

> 

/ 

insert  into  EMP: 

<  2200,  'Dugan', 

4, 

' salesman' , 

2400, 

1650 . 00, 

900.00 

> 

/ 

insert  into  EMP: 

<  1200,  '0"Neil' , 

2, 

' salesman' , 

1100, 

1500.00, 

150.00 

> 

/ 

» 

insert  into  EMP: 

<  2100,  'Reilly', 

3, 

' salesman' , 

2400, 

2500.00, 

1500.00 

> 

/ 

insert  into  EMP: 

<  1100,  'Whittaker', 

2, 

' salesman' , 

2400, 

2500.00, 

500.00 

> 

/ 

insert  into  EMP: 

<  2000,  'Jones' , 

1, 

'clerk' , 

1300, 

900.00, 

0 . 00 

> 

/ 

> 

insert  into  EMP: 

<  1000,  'Smith', 

5, 

' salesman' , 

2100, 

1500.00, 

1000.00 

>  / 

file  FILL . ITE 


insert  into  item: 


1 

<  1234,1002,100,  02/23/84,15.75,2, 
insert  into  item: 

13.49  > 

/ 

<  1013,1012,104,  02/08/84,  9.97,2, 
insert  into  item: 

9.23  > 

/ 

<  1012,1011,104,  02/08/84,  5.77,1, 
insert  into  item: 

5.75  > 

/ 

> 

<  1011,91117,103,02/15/84,  3.35,1, 
insert  into  item: 

2.20  > 

/ 

<  1010,91117,103,01/15/84,  3.03,1, 
insert  into  item: 

3.00  > 

/ 

<  1009,61117,103,02/15/84,  2.82,2, 
insert  into  item: 

2.00  > 

/ 

) 

<  1008,61117,103,01/15/84,  2.47,2, 
insert  into  item: 

2 . 20  > 

/ 

<  1007,  1002,102,01/19/84,  9.19,1, 
insert  into  item: 

5 . 25  > 

/ 

<  1006,55271,101,02/15/84,  7.23,1, 
insert  into  item: 

6.00  > 

/ 

1 

<  1005,55071,101,02/25/84,11 .29,3, 
insert  into  item: 

9.25  > 

/ 

<  1004, 5507 1,101, 02/;'  3/84, 10. 7  6,1, 

8.90  > 

/ 
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Sample  Data 


pr  rumx  iwunur\rar  wrrfTJY  >>  uwv 


TWi'T 


UNCLASSIFIED 


insert  into  item: 

<  1003,  1001,100,02/15/84,10.24,1,7.25  >  / 

insert  into  item: 

<  1002,  1001,100,02/15/84,10.24,3,7.35  >  / 

insert  into  item: 

<  1001,  1001,100,02/15/84,10.24,1,7.25  >  / 
file  FILL. MAN 

insert  into  manf  : 

<  105,'BHP  Ltd. ','17385  Weatherby  Rd.','New  York' , 'NY' , 10022  >  / 
insert  into  manf  : 

<  104, 'The  Tool  Depot', '7562  Orange  Dr .', 'Tucson' , 'AZ' , 85745  >  / 
insert  into  manf  : 

<  103, 'Grover  Parts  and  Supplies' ,' 9462  Jackson  Road' ,' Rancho  Cordova', 
insert  into  manf  : 

<  102, 'A  &  H  Industries,  Inc. ','2434  Evergreen  Ave. ', 'Eagan' , 'MN' , 55422  >  / 
insert  into  manf  : 

<  101, 'Precision  Tool  Co. ','2600  West  16th  Street', 'San  Francisco', 
insert  into  manf  : 

<  100, 'RH  Smith  Manufacturing' ,' 523  Galveston  Ave .', 'Centerville' , 'CA' , 95923  >  / 
file  FILL. MOD 


$ 

k 

I 

v. 


insert  into 

model : 

<  1012 

104, 

'1/2"  socket 

wrench'  > 

/ 

insert  into 

model : 

<  1011  , 

104, 

'combination 

pliers'  > 

/ 

insert  into 

model : 

<  91117  , 

103, 

'6"  slotted 

screwdriver 

'  >  / 

insert  into 

model : 

<  81117  , 

103, 

'6"  Phillips 

screwdriver'  >  / 

insert  into 

model : 

<  71117  , 

103, 

'3"  slotted 

screwdriver 

'  >  / 

insert  into 

model : 

<  61117  , 

103, 

'3"  Phillips 

screwdriver'  >  / 

insert  into 

model : 

<  1002  , 

102, 

'leather  mallet'  >  / 

insert  into 

model : 

<  1001 

102, 

'vise  grips' 

>  / 

insert  into 

model : 

<  55371  , 

101, 

'needle  nose 

pliers'  > 

/ 

insert  into 

model : 

<  55271  , 

101, 

' combination 

pliers'  > 

/ 

insert  into 

model : 

<  55171  , 

101, 

'1/2"  box  end  wrench' 

>  / 

insert  into 

model : 

<  55071  , 

101, 

'1/2"  socket 

wrench'  > 

/ 

insert  into 

model : 

<  1003 

100, 

'1/2"  open  end  wrench' 

>  / 
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■r.; 

I 

■:? 

» 

„v 
*  *  > 

31 


*■ 


ft 


UNCLASSIFIED 


insert  into 

model : 

<  1002  , 

100, 

'3/4" 

socket 

wrench' 

>  / 

insert  into 

model : 

<  1001  , 

100, 

'1/2" 

socket 

wrench' 

>  / 

file  FILL . ORD 


insert  into  orders : 

<  o,  **/**/**,  0  >  / 

insert  into  orders : 

<  3,  06/28/82,  2  >  / 
insert  into  orders : 

<  2,  04/02/82,  3  >  / 
insert  into  orders : 

<  1,  04/02/82,  1  >  / 


file  FILL. TAX 


insert  into 

<  85600.00, 
insert  into 

<  60000.00, 
insert  into 

<  45800.00, 
insert  into 

<  35200.00, 
insert  into 

<  29900.00, 
insert  into 

<  24600.00, 
insert  into 

<  20200.00, 
insert  into 
<  16000.00, 
insert  into 

<  11900.00, 
insert  into 

<  7600.00, 
insert  into 

<  5500.00, 
insert  into 

<  3400.00, 
insert  into 

<  0.00, 


TAXES: 
99999.00, 
TAXES: 
85600 . 00, 
TAXES: 
60000.00, 
TAXES: 
45800.00, 
TAXES: 
35200.00, 
TAXES: 
29900 . 00, 
TAXES: 
24600 . 00, 
TAXES: 
20200 . 00, 
TAXES: 
16000 . 00, 
TAXES: 
11600.00, 
TAXES: 

7600.00, 
TAXES : 

5500.00, 
TAXES : 
3400 . 00, 


30249.00, 
17705.00, 
11457 . 00, 
7323.00, 
5574.00, 
4037.00, 
2937. 00, 
2013 . 00, 
1234 . 00, 
546. 00, 
252. 00, 
0.00, 
0.00, 


0.50000  >  / 
0.49000  >  / 
0.44000  >  / 
0.39000  >  / 
0.33000  >  / 
0.29000  >  / 
0.25000  >  / 
0.22000  >  / 
0.19000  >  / 
0.16000  >  / 
0.14000  >  / 
0 . 12000  >  / 
0.00000  >  / 


» 


m 


ft' 


r 


i 


% 


p 

i 


i 


i 
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